Theory Library_Complements
section ‹Additions to the library›
theory Library_Complements
imports "HOL-Analysis.Analysis" "HOL-Cardinals.Cardinal_Order_Relation"
begin
subsection ‹Mono intros›
text ‹We have a lot of (large) inequalities to prove. It is very convenient to have a set of
introduction rules for this purpose (a lot should be added to it, I have put here all the ones
I needed).
The typical use case is when one wants to prove some inequality, say
$ \exp (x*x) \leq y + \exp(1 + z * z + y)$, assuming $y \geq 0$ and $0 \leq x \leq z$.
One would write it has
\begin{verbatim}
have "0 + \exp(0 + x * x + 0) < = y + \exp(1 + z * z + y)"
using `y > = 0` `x < = z` by (intro mono_intros)
\end{verbatim}
When the left and right hand terms are written in completely analogous ways as above, then the
introduction rules (that contain monotonicity of addition, of the exponential, and so on) reduce
this to comparison of elementary terms in the formula. This is a very naive strategy, that fails
in many situations, but that is very efficient when used correctly.
›
named_theorems mono_intros "structural introduction rules to prove inequalities"
declare le_imp_neg_le [mono_intros]
declare add_left_mono [mono_intros]
declare add_right_mono [mono_intros]
declare add_strict_left_mono [mono_intros]
declare add_strict_right_mono [mono_intros]
declare add_mono [mono_intros]
declare add_less_le_mono [mono_intros]
declare diff_right_mono [mono_intros]
declare diff_left_mono [mono_intros]
declare diff_mono [mono_intros]
declare mult_left_mono [mono_intros]
declare mult_right_mono [mono_intros]
declare mult_mono [mono_intros]
declare max.mono [mono_intros]
declare min.mono [mono_intros]
declare power_mono [mono_intros]
declare ln_ge_zero [mono_intros]
declare ln_le_minus_one [mono_intros]
declare ennreal_minus_mono [mono_intros]
declare ennreal_leI [mono_intros]
declare e2ennreal_mono [mono_intros]
declare enn2ereal_nonneg [mono_intros]
declare zero_le [mono_intros]
declare top_greatest [mono_intros]
declare bot_least [mono_intros]
declare dist_triangle [mono_intros]
declare dist_triangle2 [mono_intros]
declare dist_triangle3 [mono_intros]
declare exp_ge_add_one_self [mono_intros]
declare exp_gt_one [mono_intros]
declare exp_less_mono [mono_intros]
declare dist_triangle [mono_intros]
declare abs_triangle_ineq [mono_intros]
declare abs_triangle_ineq2 [mono_intros]
declare abs_triangle_ineq2_sym [mono_intros]
declare abs_triangle_ineq3 [mono_intros]
declare abs_triangle_ineq4 [mono_intros]
declare Liminf_le_Limsup [mono_intros]
declare ereal_liminf_add_mono [mono_intros]
declare le_of_int_ceiling [mono_intros]
declare ereal_minus_mono [mono_intros]
declare infdist_triangle [mono_intros]
declare divide_right_mono [mono_intros]
declare self_le_power [mono_intros]
lemma ln_le_cancelI [mono_intros]:
assumes "(0::real) < x" "x ≤ y"
shows "ln x ≤ ln y"
using assms by auto
lemma exp_le_cancelI [mono_intros]:
assumes "x ≤ (y::real)"
shows "exp x ≤ exp y"
using assms by simp
lemma mult_ge1_mono [mono_intros]:
assumes "a ≥ (0::'a::linordered_idom)" "b ≥ 1"
shows "a ≤ a * b" "a ≤ b * a"
using assms mult_le_cancel_left1 mult_le_cancel_right1 by force+
text ‹A few convexity inequalities we will need later on.›
lemma xy_le_uxx_vyy [mono_intros]:
assumes "u > 0" "u * v = (1::real)"
shows "x * y ≤ u * x^2/2 + v * y^2/2"
proof -
have "v > 0" using assms
by (metis (full_types) dual_order.strict_implies_order le_less_linear mult_nonneg_nonpos not_one_le_zero)
then have *: "sqrt u * sqrt v = 1"
using assms by (metis real_sqrt_mult real_sqrt_one)
have "(sqrt u * x - sqrt v * y)^2 ≥ 0" by auto
then have "u * x^2 + v * y^2 - 2 * 1 * x * y ≥ 0"
unfolding power2_eq_square *[symmetric] using ‹u > 0› ‹v > 0› by (auto simp add: algebra_simps)
then show ?thesis by (auto simp add: algebra_simps divide_simps)
qed
lemma xy_le_xx_yy [mono_intros]:
"x * y ≤ x^2/2 + y^2/2" for x y::real
using xy_le_uxx_vyy[of 1 1] by auto
lemma ln_squared_bound [mono_intros]:
"(ln x)^2 ≤ 2 * x - 2" if "x ≥ 1" for x::real
proof -
define f where "f = (λx::real. 2 * x - 2 - ln x * ln x)"
have *: "DERIV f x :> 2 - 2 * ln x / x" if "x > 0" for x::real
unfolding f_def using that by (auto intro!: derivative_eq_intros)
have "f 1 ≤ f x" if "x ≥ 1" for x
proof (rule DERIV_nonneg_imp_nondecreasing[OF that])
fix t::real assume "t ≥ 1"
show "∃y. (f has_real_derivative y) (at t) ∧ 0 ≤ y"
apply (rule exI[of _ "2 - 2 * ln t / t"])
using *[of t] ‹t ≥ 1› by (auto simp add: divide_simps ln_bound)
qed
then show ?thesis unfolding f_def power2_eq_square using that by auto
qed
text ‹In the next lemma, the assumptions are too strong (negative numbers
less than $-1$ also work well to have a square larger than $1$), but in practice one proves
inequalities with nonnegative numbers, so this version is really the useful one for
\verb+mono_intros+.›
lemma mult_ge1_powers [mono_intros]:
assumes "a ≥ (1::'a::linordered_idom)"
shows "1 ≤ a * a" "1 ≤ a * a * a" "1 ≤ a * a * a * a"
using assms by (meson assms dual_order.trans mult_ge1_mono(1) zero_le_one)+
lemmas [mono_intros] = ln_bound
lemma mono_cSup:
fixes f :: "'a::conditionally_complete_lattice ⇒ 'b::conditionally_complete_lattice"
assumes "bdd_above A" "A ≠ {}" "mono f"
shows "Sup (f`A) ≤ f (Sup A)"
by (metis assms(1) assms(2) assms(3) cSUP_least cSup_upper mono_def)
lemma mono_cSup_bij:
fixes f :: "'a::conditionally_complete_linorder ⇒ 'b::conditionally_complete_linorder"
assumes "bdd_above A" "A ≠ {}" "mono f" "bij f"
shows "Sup (f`A) = f(Sup A)"
proof -
have "Sup ((inv f)`(f`A)) ≤ (inv f) (Sup (f`A))"
apply (rule mono_cSup)
using mono_inv[OF assms(3) assms(4)] assms(2) bdd_above_image_mono[OF assms(3) assms(1)] by auto
then have "f (Sup ((inv f)`(f`A))) ≤ Sup (f`A)"
using assms mono_def by (metis (no_types, hide_lams) bij_betw_imp_surj_on surj_f_inv_f)
moreover have "f (Sup ((inv f)`(f`A))) = f(Sup A)"
using assms by (simp add: bij_is_inj)
ultimately show ?thesis using mono_cSup[OF assms(1) assms(2) assms(3)] by auto
qed
subsection ‹More topology›
text ‹In situations of interest to us later on, convergence is well controlled only for sequences
living in some dense subset of the space (but the limit can be anywhere). This is enough to
establish continuity of the function, if the target space is well enough separated.
The statement we give below is very general,
as we do not assume that the function is continuous inside the original set $S$, it will typically
only be continuous at a set $T$ contained in the closure of $S$. In many applications, $T$ will
be the closure of $S$, but we are also thinking of the case where one constructs an extension
of a function inside a space, to its boundary, and the behaviour at the boundary is better than
inside the space. The example we have in mind is the extension of a quasi-isometry to the boundary
of a Gromov hyperbolic space.
In the following criterion, we assume that if $u_n$ inside $S$ converges to a point at the boundary
$T$, then $f(u_n)$ converges (where $f$ is some function inside). Then, we can extend the function $f$ at
the boundary, by picking the limit value of $f(u_n)$ for some sequence converging to $u_n$. Then
the lemma asserts that $f$ is continuous at every point $b$ on the boundary.
The proof is done in two steps:
\begin{enumerate}
\item First, if $v_n$ is another inside sequence tending to
the same point $b$ on the boundary, then $f(v_n)$ converges to the same value as $f(u_n)$: this is
proved by considering the sequence $w$ equal to $u$ at even times and to $v$ at odd times, and
saying that $f(w_n)$ converges. Its limit is equal to the limit of $f(u_n)$ and of $f(v_n)$, so they
have to coincide.
\item Now, consider a general sequence $v$ (in the space or the boundary) converging to $b$. We want
to show that $f(v_n)$ tends to $f(b)$. If $v_n$ is inside $S$, we have already done it in the first
step. If it is on the boundary, on the other hand, we can approximate it by an inside point $w_n$
for which $f(w_n)$ is very close to $f(v_n)$. Then $w_n$ is an inside sequence converging to $b$,
hence $f(w_n)$ converges to $f(b)$ by the first step, and then $f(v_n)$ also converges to $f(b)$.
The precise argument is more conveniently written by contradiction. It requires good separation
properties of the target space.
\end{enumerate}›
text ‹First, we introduce the material to interpolate between two sequences, one at even times
and the other one at odd times.›
definition even_odd_interpolate::"(nat ⇒ 'a) ⇒ (nat ⇒ 'a) ⇒ (nat ⇒ 'a)"
where "even_odd_interpolate u v n = (if even n then u (n div 2) else v (n div 2))"
lemma even_odd_interpolate_compose:
"even_odd_interpolate (f o u) (f o v) = f o (even_odd_interpolate u v)"
unfolding even_odd_interpolate_def comp_def by auto
lemma even_odd_interpolate_filterlim:
"filterlim u F sequentially ∧ filterlim v F sequentially ⟷ filterlim (even_odd_interpolate u v) F sequentially"
proof (auto)
assume H: "filterlim (even_odd_interpolate u v) F sequentially"
define r::"nat ⇒ nat" where "r = (λn. 2 * n)"
have "strict_mono r" unfolding r_def strict_mono_def by auto
then have "filterlim r sequentially sequentially"
by (simp add: filterlim_subseq)
have "filterlim (λn. (even_odd_interpolate u v) (r n)) F sequentially"
by (rule filterlim_compose[OF H filterlim_subseq[OF ‹strict_mono r›]])
moreover have "even_odd_interpolate u v (r n) = u n" for n
unfolding r_def even_odd_interpolate_def by auto
ultimately show "filterlim u F sequentially" by auto
define r::"nat ⇒ nat" where "r = (λn. 2 * n + 1)"
have "strict_mono r" unfolding r_def strict_mono_def by auto
then have "filterlim r sequentially sequentially"
by (simp add: filterlim_subseq)
have "filterlim (λn. (even_odd_interpolate u v) (r n)) F sequentially"
by (rule filterlim_compose[OF H filterlim_subseq[OF ‹strict_mono r›]])
moreover have "even_odd_interpolate u v (r n) = v n" for n
unfolding r_def even_odd_interpolate_def by auto
ultimately show "filterlim v F sequentially" by auto
next
assume H: "filterlim u F sequentially" "filterlim v F sequentially"
show "filterlim (even_odd_interpolate u v) F sequentially"
unfolding filterlim_iff eventually_sequentially proof (auto)
fix P assume *: "eventually P F"
obtain N1 where N1: "⋀n. n ≥ N1 ⟹ P (u n)"
using H(1) unfolding filterlim_iff eventually_sequentially using * by auto
obtain N2 where N2: "⋀n. n ≥ N2 ⟹ P (v n)"
using H(2) unfolding filterlim_iff eventually_sequentially using * by auto
have "P (even_odd_interpolate u v n)" if "n ≥ 2 * N1 + 2 * N2" for n
proof (cases "even n")
case True
have "n div 2 ≥ N1" using that by auto
then show ?thesis unfolding even_odd_interpolate_def using True N1 by auto
next
case False
have "n div 2 ≥ N2" using that by auto
then show ?thesis unfolding even_odd_interpolate_def using False N2 by auto
qed
then show "∃N. ∀n ≥ N. P (even_odd_interpolate u v n)" by auto
qed
qed
text ‹Then, we prove the continuity criterion for extensions of functions to the boundary $T$ of a set
$S$. The first assumption is that $f(u_n)$ converges when $f$ converges to the boundary, and the
second one that the extension of $f$ to the boundary has been defined using the limit along some
sequence tending to the point under consideration. The following criterion is the most general one,
but this is not the version that is most commonly applied so we use a prime in its name.›
lemma continuous_at_extension_sequentially':
fixes f :: "'a::{first_countable_topology, t2_space} ⇒ 'b::t3_space"
assumes "b ∈ T"
"⋀u b. (∀n. u n ∈ S) ⟹ b ∈ T ⟹ u ⇢ b ⟹ convergent (λn. f (u n))"
"⋀b. b ∈ T ⟹ ∃u. (∀n. u n ∈ S) ∧ u ⇢ b ∧ ((λn. f (u n)) ⇢ f b)"
shows "continuous (at b within (S ∪ T)) f"
proof -
have first_step: "(λn. f (u n)) ⇢ f c" if "⋀n. u n ∈ S" "u ⇢ c" "c ∈ T" for u c
proof -
obtain v where v: "⋀n. v n ∈ S" "v ⇢ c" "(λn. f (v n)) ⇢ f c"
using assms(3)[OF ‹c ∈ T›] by blast
then have A: "even_odd_interpolate u v ⇢ c"
unfolding even_odd_interpolate_filterlim[symmetric] using ‹u ⇢ c› by auto
moreover have B: "∀n. even_odd_interpolate u v n ∈ S"
using ‹⋀n. u n ∈ S› ‹⋀n. v n ∈ S› unfolding even_odd_interpolate_def by auto
have "convergent (λn. f (even_odd_interpolate u v n))"
by (rule assms(2)[OF B ‹c ∈ T› A])
then obtain m where "(λn. f (even_odd_interpolate u v n)) ⇢ m"
unfolding convergent_def by auto
then have "even_odd_interpolate (f o u) (f o v) ⇢ m"
unfolding even_odd_interpolate_compose unfolding comp_def by auto
then have "(f o u) ⇢ m" "(f o v) ⇢ m"
unfolding even_odd_interpolate_filterlim[symmetric] by auto
then have "m = f c" using v(3) unfolding comp_def using LIMSEQ_unique by auto
then show ?thesis using ‹(f o u) ⇢ m› unfolding comp_def by auto
qed
show "continuous (at b within (S ∪ T)) f"
proof (rule ccontr)
assume "¬ ?thesis"
then obtain U where U: "open U" "f b ∈ U" "¬(∀⇩F x in at b within S ∪ T. f x ∈ U)"
unfolding continuous_within tendsto_def[where l = "f b"] using sequentially_imp_eventually_nhds_within by auto
have "∃V W. open V ∧ open W ∧ f b ∈ V ∧ (UNIV - U) ⊆ W ∧ V ∩ W = {}"
apply (rule t3_space) using U by auto
then obtain V W where VW: "open V" "open W" "f b ∈ V" "UNIV - U ⊆ W" "V ∩ W = {}"
by auto
obtain A :: "nat ⇒ 'a set" where *:
"⋀i. open (A i)"
"⋀i. b ∈ A i"
"⋀F. ∀n. F n ∈ A n ⟹ F ⇢ b"
by (rule first_countable_topology_class.countable_basis) blast
with * U(3) have "∃F. ∀n. F n ∈ S ∪ T ∧ F n ∈ A n ∧ ¬ (f(F n) ∈ U)"
unfolding at_within_def eventually_inf_principal eventually_nhds
by (intro choice) (meson DiffE)
then obtain F where F: "⋀n. F n ∈ S ∪ T" "⋀n. F n ∈ A n" "⋀n. f(F n) ∉ U"
by auto
have "∃y. y ∈ S ∧ y ∈ A n ∧ f y ∈ W" for n
proof (cases "F n ∈ S")
case True
show ?thesis apply (rule exI[of _ "F n"]) using F VW True by auto
next
case False
then have "F n ∈ T" using ‹F n ∈ S ∪ T› by auto
obtain u where u: "⋀p. u p ∈ S" "u ⇢ F n" "(λp. f (u p)) ⇢ f(F n)"
using assms(3)[OF ‹F n ∈ T›] by auto
moreover have "f(F n) ∈ W" using F VW by auto
ultimately have "eventually (λp. f (u p) ∈ W) sequentially"
using ‹open W› by (simp add: tendsto_def)
moreover have "eventually (λp. u p ∈ A n) sequentially"
using ‹F n ∈ A n› u ‹open (A n)› by (simp add: tendsto_def)
ultimately have "∃p. f(u p) ∈ W ∧ u p ∈ A n"
using eventually_False_sequentially eventually_elim2 by blast
then show ?thesis using u(1) by auto
qed
then have "∃u. ∀n. u n ∈ S ∧ u n ∈ A n ∧ f (u n) ∈ W"
by (auto intro: choice)
then obtain u where u: "⋀n. u n ∈ S" "⋀n. u n ∈ A n" "⋀n. f (u n) ∈ W"
by blast
then have "u ⇢ b" using *(3) by auto
then have "(λn. f (u n)) ⇢ f b" using first_step assms u by auto
then have "eventually (λn. f (u n) ∈ V) sequentially"
using VW by (simp add: tendsto_def)
then have "∃n. f (u n) ∈ V"
using eventually_False_sequentially eventually_elim2 by blast
then show False
using u(3) ‹V ∩ W = {}› by auto
qed
qed
text ‹We can specialize the previous statement to the common case where one already knows the
sequential continuity of $f$ along sequences in $S$ converging to a point in $T$. This will be the
case in most --but not all-- applications. This is a straightforward application of the above
criterion.›
proposition continuous_at_extension_sequentially:
fixes f :: "'a::{first_countable_topology, t2_space} ⇒ 'b::t3_space"
assumes "a ∈ T"
"T ⊆ closure S"
"⋀u b. (∀n. u n ∈ S) ⟹ b ∈ T ⟹ u ⇢ b ⟹ (λn. f (u n)) ⇢ f b"
shows "continuous (at a within (S ∪ T)) f"
apply (rule continuous_at_extension_sequentially'[OF ‹a ∈ T›])
using assms(3) convergent_def apply blast
by (metis assms(2) assms(3) closure_sequential subset_iff)
text ‹We also give global versions. We can only express the continuity on $T$, so
this is slightly weaker than the previous statements since we are not saying anything on inside
sequences tending to $T$ -- but in cases where $T$ contains $S$ these statements contain all the
information.›
lemma continuous_on_extension_sequentially':
fixes f :: "'a::{first_countable_topology, t2_space} ⇒ 'b::t3_space"
assumes "⋀u b. (∀n. u n ∈ S) ⟹ b ∈ T ⟹ u ⇢ b ⟹ convergent (λn. f (u n))"
"⋀b. b ∈ T ⟹ ∃u. (∀n. u n ∈ S) ∧ u ⇢ b ∧ ((λn. f (u n)) ⇢ f b)"
shows "continuous_on T f"
unfolding continuous_on_eq_continuous_within apply (auto intro!: continuous_within_subset[of _ "S ∪ T" f T])
by (intro continuous_at_extension_sequentially'[OF _ assms], auto)
lemma continuous_on_extension_sequentially:
fixes f :: "'a::{first_countable_topology, t2_space} ⇒ 'b::t3_space"
assumes "T ⊆ closure S"
"⋀u b. (∀n. u n ∈ S) ⟹ b ∈ T ⟹ u ⇢ b ⟹ (λn. f (u n)) ⇢ f b"
shows "continuous_on T f"
unfolding continuous_on_eq_continuous_within apply (auto intro!: continuous_within_subset[of _ "S ∪ T" f T])
by (intro continuous_at_extension_sequentially[OF _ assms], auto)
subsubsection ‹Homeomorphisms›
text ‹A variant around the notion of homeomorphism, which is only expressed in terms of the
function and not of its inverse.›
definition homeomorphism_on::"'a set ⇒ ('a::topological_space ⇒ 'b::topological_space) ⇒ bool"
where "homeomorphism_on S f = (∃g. homeomorphism S (f`S) f g)"
lemma homeomorphism_on_continuous:
assumes "homeomorphism_on S f"
shows "continuous_on S f"
using assms unfolding homeomorphism_on_def homeomorphism_def by auto
lemma homeomorphism_on_bij:
assumes "homeomorphism_on S f"
shows "bij_betw f S (f`S)"
using assms unfolding homeomorphism_on_def homeomorphism_def by auto (metis inj_on_def inj_on_imp_bij_betw)
lemma homeomorphism_on_homeomorphic:
assumes "homeomorphism_on S f"
shows "S homeomorphic (f`S)"
using assms unfolding homeomorphism_on_def homeomorphic_def by auto
lemma homeomorphism_on_compact:
fixes f::"'a::topological_space ⇒ 'b::t2_space"
assumes "continuous_on S f"
"compact S"
"inj_on f S"
shows "homeomorphism_on S f"
unfolding homeomorphism_on_def using homeomorphism_compact[OF assms(2) assms(1) _ assms(3)] by auto
lemma homeomorphism_on_subset:
assumes "homeomorphism_on S f"
"T ⊆ S"
shows "homeomorphism_on T f"
using assms homeomorphism_of_subsets unfolding homeomorphism_on_def by blast
lemma homeomorphism_on_empty [simp]:
"homeomorphism_on {} f"
unfolding homeomorphism_on_def using homeomorphism_empty[of f] by auto
lemma homeomorphism_on_cong:
assumes "homeomorphism_on X f"
"X' = X" "⋀x. x ∈ X ⟹ f' x = f x"
shows "homeomorphism_on X' f'"
proof -
obtain g where g:"homeomorphism X (f`X) f g"
using assms unfolding homeomorphism_on_def by auto
have "homeomorphism X' (f'`X') f' g"
apply (rule homeomorphism_cong[OF g]) using assms by (auto simp add: rev_image_eqI)
then show ?thesis
unfolding homeomorphism_on_def by auto
qed
lemma homeomorphism_on_inverse:
fixes f::"'a::topological_space ⇒ 'b::topological_space"
assumes "homeomorphism_on X f"
shows "homeomorphism_on (f`X) (inv_into X f)"
proof -
obtain g where g: "homeomorphism X (f`X) f g"
using assms unfolding homeomorphism_on_def by auto
then have "g`f`X = X"
by (simp add: homeomorphism_def)
then have "homeomorphism_on (f`X) g"
unfolding homeomorphism_on_def using homeomorphism_symD[OF g] by auto
moreover have "g x = inv_into X f x" if "x ∈ f`X" for x
using g that unfolding homeomorphism_def by (auto, metis f_inv_into_f inv_into_into that)
ultimately show ?thesis
using homeomorphism_on_cong by force
qed
text ‹Characterization of homeomorphisms in terms of sequences: a map is a homeomorphism if and
only if it respects convergent sequences.›
lemma homeomorphism_on_compose:
assumes "homeomorphism_on S f"
"x ∈ S"
"eventually (λn. u n ∈ S) F"
shows "(u ⤏ x) F ⟷ ((λn. f (u n)) ⤏ f x) F"
proof
assume "(u ⤏ x) F"
then show "((λn. f (u n)) ⤏ f x) F"
using continuous_on_tendsto_compose[OF homeomorphism_on_continuous[OF assms(1)] _ assms(2) assms(3)] by simp
next
assume *: "((λn. f (u n)) ⤏ f x) F"
have I: "inv_into S f (f y) = y" if "y ∈ S" for y
using homeomorphism_on_bij[OF assms(1)] by (meson bij_betw_inv_into_left that)
then have A: "eventually (λn. u n = inv_into S f (f (u n))) F"
using assms eventually_mono by force
have "((λn. (inv_into S f) (f (u n))) ⤏ (inv_into S f) (f x)) F"
apply (rule continuous_on_tendsto_compose[OF homeomorphism_on_continuous[OF homeomorphism_on_inverse[OF assms(1)]] *])
using assms eventually_mono by (auto) fastforce
then show "(u ⤏ x) F"
unfolding tendsto_cong[OF A] I[OF ‹x ∈ S›] by simp
qed
lemma homeomorphism_on_sequentially:
fixes f::"'a::{first_countable_topology, t2_space} ⇒ 'b::{first_countable_topology, t2_space}"
assumes "⋀x u. x ∈ S ⟹ (∀n. u n ∈ S) ⟹ u ⇢ x ⟷ (λn. f (u n)) ⇢ f x"
shows "homeomorphism_on S f"
proof -
have "x = y" if "f x = f y" "x ∈ S" "y ∈ S" for x y
proof -
have "(λn. f x) ⇢ f y" using that by auto
then have "(λn. x) ⇢ y" using assms(1) that by auto
then show "x = y" using LIMSEQ_unique by auto
qed
then have "inj_on f S" by (simp add: inj_on_def)
have Cf: "continuous_on S f"
apply (rule continuous_on_sequentiallyI) using assms by auto
define g where "g = inv_into S f"
have Cg: "continuous_on (f`S) g"
proof (rule continuous_on_sequentiallyI)
fix v b assume H: "∀n. v n ∈ f ` S" "b ∈ f ` S" "v ⇢ b"
define u where "u = (λn. g (v n))"
define a where "a = g b"
have "u n ∈ S" "f (u n) = v n" for n
unfolding u_def g_def using H(1) by (auto simp add: inv_into_into f_inv_into_f)
have "a ∈ S" "f a = b"
unfolding a_def g_def using H(2) by (auto simp add: inv_into_into f_inv_into_f)
show "(λn. g(v n)) ⇢ g b"
unfolding u_def[symmetric] a_def[symmetric] apply (rule iffD2[OF assms])
using ‹⋀n. u n ∈ S› ‹a ∈ S› ‹v ⇢ b›
unfolding ‹⋀n. f (u n) = v n› ‹f a = b› by auto
qed
have "homeomorphism S (f`S) f g"
apply (rule homeomorphismI[OF Cf Cg]) unfolding g_def using ‹inj_on f S› by auto
then show ?thesis
unfolding homeomorphism_on_def by auto
qed
lemma homeomorphism_on_UNIV_sequentially:
fixes f::"'a::{first_countable_topology, t2_space} ⇒ 'b::{first_countable_topology, t2_space}"
assumes "⋀x u. u ⇢ x ⟷ (λn. f (u n)) ⇢ f x"
shows "homeomorphism_on UNIV f"
using assms by (auto intro!: homeomorphism_on_sequentially)
text ‹Now, we give similar characterizations in terms of sequences living in a dense subset. As
in the sequential continuity criteria above, we first give a very general criterion, where the map
does not have to be continuous on the approximating set $S$, only on the limit set $T$, without
any a priori identification of the limit. Then, we specialize this statement to a less general
but often more usable version.›
lemma homeomorphism_on_extension_sequentially_precise:
fixes f::"'a::{first_countable_topology, t3_space} ⇒ 'b::{first_countable_topology, t3_space}"
assumes "⋀u b. (∀n. u n ∈ S) ⟹ b ∈ T ⟹ u ⇢ b ⟹ convergent (λn. f (u n))"
"⋀u c. (∀n. u n ∈ S) ⟹ c ∈ f`T ⟹ (λn. f (u n)) ⇢ c ⟹ convergent u"
"⋀b. b ∈ T ⟹ ∃u. (∀n. u n ∈ S) ∧ u ⇢ b ∧ ((λn. f (u n)) ⇢ f b)"
"⋀n. u n ∈ S ∪ T" "l ∈ T"
shows "u ⇢ l ⟷ (λn. f (u n)) ⇢ f l"
proof
assume H: "u ⇢ l"
have "continuous (at l within (S ∪ T)) f"
apply (rule continuous_at_extension_sequentially'[OF ‹l ∈ T›]) using assms(1) assms(3) by auto
then show "(λn. f (u n)) ⇢ f l"
apply (rule continuous_within_tendsto_compose) using H assms(4) by auto
next
text ‹For the reverse implication, we would like to use the continuity criterion
\verb+ continuous_at_extension_sequentially'+ applied to the inverse of $f$. Unfortunately, this
inverse is only well defined on $T$, while our sequence takes values in $S \cup T$. So, instead,
we redo by hand the proof of the continuity criterion, but in the opposite direction.›
assume H: "(λn. f (u n)) ⇢ f l"
show "u ⇢ l"
proof (rule ccontr)
assume "¬ ?thesis"
then obtain U where U: "open U" "l ∈ U" "¬(∀⇩F n in sequentially. u n ∈ U)"
unfolding continuous_within tendsto_def[where l = l] using sequentially_imp_eventually_nhds_within by auto
obtain A :: "nat ⇒ 'b set" where *:
"⋀i. open (A i)"
"⋀i. f l ∈ A i"
"⋀F. ∀n. F n ∈ A n ⟹ F ⇢ f l"
by (rule first_countable_topology_class.countable_basis) blast
have B: "eventually (λn. f (u n) ∈ A i) sequentially" for i
using ‹open (A i)› ‹f l ∈ A i› H topological_tendstoD by fastforce
have M: "∃r. r ≥ N ∧ (u r ∉ U) ∧ f (u r) ∈ A i" for N i
using U(3) B[of i] unfolding eventually_sequentially by (meson dual_order.trans le_cases)
have "∃r. ∀n. (u (r n) ∉ U ∧ f (u (r n)) ∈ A n) ∧ r (Suc n) ≥ r n + 1"
apply (rule dependent_nat_choice) using M by auto
then obtain r where r: "⋀n. u (r n) ∉ U" "⋀n. f (u (r n)) ∈ A n" "⋀n. r (Suc n) ≥ r n + 1"
by auto
then have "strict_mono r"
by (metis Suc_eq_plus1 Suc_le_lessD strict_monoI_Suc)
have "∃V W. open V ∧ open W ∧ l ∈ V ∧ (UNIV - U) ⊆ W ∧ V ∩ W = {}"
apply (rule t3_space) using U by auto
then obtain V W where VW: "open V" "open W" "l ∈ V" "UNIV - U ⊆ W" "V ∩ W = {}"
by auto
have "∃z. z ∈ S ∧ f z ∈ A n ∧ z ∈ W" for n
proof -
define z where "z = u (r n)"
have "f z ∈ A n" unfolding z_def using r(2) by auto
have "z ∈ S ∪ T" "z ∉ U"
unfolding z_def using r(1) assms(4) by auto
then have "z ∈ W" using VW by auto
show ?thesis
proof (cases "z ∈ T")
case True
obtain u::"nat ⇒ 'a" where u: "⋀p. u p ∈ S" "u ⇢ z" "(λp. f (u p)) ⇢ f z"
using assms(3)[OF ‹z ∈ T›] by auto
then have "eventually (λp. f (u p) ∈ A n) sequentially"
using ‹open (A n)› ‹f z ∈ A n› unfolding tendsto_def by simp
moreover have "eventually (λp. u p ∈ W) sequentially"
using ‹open W› ‹z ∈ W› u unfolding tendsto_def by simp
ultimately have "∃p. u p ∈ W ∧ f (u p) ∈ A n"
using eventually_False_sequentially eventually_elim2 by blast
then show ?thesis using u(1) by auto
next
case False
then have "z ∈ S" using ‹z ∈ S ∪ T› by auto
then show ?thesis using ‹f z ∈ A n› ‹z ∈ W› by auto
qed
qed
then have "∃v. ∀n. v n ∈ S ∧ f (v n) ∈ A n ∧ v n ∈ W"
by (auto intro: choice)
then obtain v where v: "⋀n. v n ∈ S" "⋀n. f (v n) ∈ A n" "⋀n. v n ∈ W"
by blast
then have I: "(λn. f (v n)) ⇢ f l" using *(3) by auto
obtain w where w: "⋀n. w n ∈ S" "w ⇢ l" "((λn. f (w n)) ⇢ f l)"
using assms(3)[OF ‹l ∈ T›] by auto
have "even_odd_interpolate (f o v) (f o w) ⇢ f l"
unfolding even_odd_interpolate_filterlim[symmetric] comp_def using v w I by auto
then have *: "(λn. f (even_odd_interpolate v w n)) ⇢ f l"
unfolding even_odd_interpolate_compose unfolding comp_def by auto
have "convergent (even_odd_interpolate v w)"
apply (rule assms(2)[OF _ _ *])
unfolding even_odd_interpolate_def using v(1) w(1) ‹l ∈ T› by auto
then obtain z where "even_odd_interpolate v w ⇢ z"
unfolding convergent_def by auto
then have *: "v ⇢ z" "w ⇢ z" unfolding even_odd_interpolate_filterlim[symmetric] by auto
then have "z = l" using v(2) w(2) LIMSEQ_unique by auto
then have "v ⇢ l" using * by simp
then have "eventually (λn. v n ∈ V) sequentially"
using VW by (simp add: tendsto_def)
then have "∃n. v n ∈ V"
using eventually_False_sequentially eventually_elim2 by blast
then show False
using v(3) ‹V ∩ W = {}› by auto
qed
qed
lemma homeomorphism_on_extension_sequentially':
fixes f::"'a::{first_countable_topology, t3_space} ⇒ 'b::{first_countable_topology, t3_space}"
assumes "⋀u b. (∀n. u n ∈ S) ⟹ b ∈ T ⟹ u ⇢ b ⟹ convergent (λn. f (u n))"
"⋀u c. (∀n. u n ∈ S) ⟹ c ∈ f`T ⟹ (λn. f (u n)) ⇢ c ⟹ convergent u"
"⋀b. b ∈ T ⟹ ∃u. (∀n. u n ∈ S) ∧ u ⇢ b ∧ ((λn. f (u n)) ⇢ f b)"
shows "homeomorphism_on T f"
apply (rule homeomorphism_on_sequentially, rule homeomorphism_on_extension_sequentially_precise[of S T])
using assms by auto
proposition homeomorphism_on_extension_sequentially:
fixes f::"'a::{first_countable_topology, t3_space} ⇒ 'b::{first_countable_topology, t3_space}"
assumes "⋀u b. (∀n. u n ∈ S) ⟹ u ⇢ b ⟷ (λn. f (u n)) ⇢ f b"
"T ⊆ closure S"
shows "homeomorphism_on T f"
apply (rule homeomorphism_on_extension_sequentially'[of S])
using assms(1) convergent_def apply fastforce
using assms(1) convergent_def apply blast
by (metis assms(1) assms(2) closure_sequential subsetCE)
lemma homeomorphism_on_UNIV_extension_sequentially:
fixes f::"'a::{first_countable_topology, t3_space} ⇒ 'b::{first_countable_topology, t3_space}"
assumes "⋀u b. (∀n. u n ∈ S) ⟹ u ⇢ b ⟷ (λn. f (u n)) ⇢ f b"
"closure S = UNIV"
shows "homeomorphism_on UNIV f"
apply (rule homeomorphism_on_extension_sequentially[of S]) using assms by auto
subsubsection ‹Proper spaces›
text ‹Proper spaces, i.e., spaces in which every closed ball is compact -- or, equivalently,
any closed bounded set is compact.›
definition proper::"('a::metric_space) set ⇒ bool"
where "proper S ≡ (∀ x r. compact (cball x r ∩ S))"
lemma properI:
assumes "⋀x r. compact (cball x r ∩ S)"
shows "proper S"
using assms unfolding proper_def by auto
lemma proper_compact_cball:
assumes "proper (UNIV::'a::metric_space set)"
shows "compact (cball (x::'a) r)"
using assms unfolding proper_def by auto
lemma proper_compact_bounded_closed:
assumes "proper (UNIV::'a::metric_space set)" "closed (S::'a set)" "bounded S"
shows "compact S"
proof -
obtain x r where "S ⊆ cball x r"
using ‹bounded S› bounded_subset_cball by blast
then have *: "S = S ∩ cball x r"
by auto
show ?thesis
apply (subst *, rule closed_Int_compact) using assms unfolding proper_def by auto
qed
lemma proper_real [simp]:
"proper (UNIV::real set)"
unfolding proper_def by auto
lemma complete_of_proper:
assumes "proper S"
shows "complete S"
proof -
have "∃l∈S. u ⇢ l" if "Cauchy u" "⋀n. u n ∈ S" for u
proof -
have "bounded (range u)"
using ‹Cauchy u› cauchy_imp_bounded by auto
then obtain x r where *: "⋀n. dist x (u n) ≤ r"
unfolding bounded_def by auto
then have "u n ∈ (cball x r) ∩ S" for n using ‹u n ∈ S› by auto
moreover have "complete ((cball x r) ∩ S)"
apply (rule compact_imp_complete) using assms unfolding proper_def by auto
ultimately show ?thesis
unfolding complete_def using ‹Cauchy u› by auto
qed
then show ?thesis
unfolding complete_def by auto
qed
lemma proper_of_compact:
assumes "compact S"
shows "proper S"
using assms by (auto intro: properI)
lemma proper_Un:
assumes "proper A" "proper B"
shows "proper (A ∪ B)"
using assms unfolding proper_def by (auto simp add: compact_Un inf_sup_distrib1)
subsubsection ‹Miscellaneous topology›
text ‹When manipulating the triangle inequality, it is very frequent to deal with 4 points
(and automation has trouble doing it automatically). Even sometimes with 5 points...›
lemma dist_triangle4 [mono_intros]:
"dist x t ≤ dist x y + dist y z + dist z t"
using dist_triangle[of x z y] dist_triangle[of x t z] by auto
lemma dist_triangle5 [mono_intros]:
"dist x u ≤ dist x y + dist y z + dist z t + dist t u"
using dist_triangle4[of x u y z] dist_triangle[of z u t] by auto
text ‹A thickening of a compact set is closed.›
lemma compact_has_closed_thickening:
assumes "compact C"
"continuous_on C f"
shows "closed (⋃x∈C. cball x (f x))"
proof (auto simp add: closed_sequential_limits)
fix u l assume *: "∀n::nat. ∃x∈C. dist x (u n) ≤ f x" "u ⇢ l"
have "∃x::nat⇒'a. ∀n. x n ∈ C ∧ dist (x n) (u n) ≤ f (x n)"
apply (rule choice) using * by auto
then obtain x::"nat ⇒ 'a" where x: "⋀n. x n ∈ C" "⋀n. dist (x n) (u n) ≤ f (x n)"
by blast
obtain r c where "strict_mono r" "c ∈ C" "(x o r) ⇢ c"
using x(1) ‹compact C› by (meson compact_eq_seq_compact_metric seq_compact_def)
then have "c ∈ C" using x(1) ‹compact C› by auto
have lim: "(λn. f (x (r n)) - dist (x (r n)) (u (r n))) ⇢ f c - dist c l"
apply (intro tendsto_intros, rule continuous_on_tendsto_compose[of C f])
using *(2) x(1) ‹(x o r) ⇢ c› ‹continuous_on C f› ‹c ∈ C› ‹strict_mono r› LIMSEQ_subseq_LIMSEQ
unfolding comp_def by auto
have "f c - dist c l ≥ 0" apply (rule LIMSEQ_le_const[OF lim]) using x(2) by auto
then show "∃x∈C. dist x l ≤ f x" using ‹c ∈ C› by auto
qed
text ‹congruence rule for continuity. The assumption that $f y = g y$ is necessary since \verb+at x+
is the pointed neighborhood at $x$.›
lemma continuous_within_cong:
assumes "continuous (at y within S) f"
"eventually (λx. f x = g x) (at y within S)"
"f y = g y"
shows "continuous (at y within S) g"
using assms continuous_within filterlim_cong by fastforce
text ‹A function which tends to infinity at infinity, on a proper set, realizes its infimum›
lemma continuous_attains_inf_proper:
fixes f :: "'a::metric_space ⇒ 'b::linorder_topology"
assumes "proper s" "a ∈ s"
"continuous_on s f"
"⋀z. z ∈ s - cball a r ⟹ f z ≥ f a"
shows "∃x∈s. ∀y∈s. f x ≤ f y"
proof (cases "r ≥ 0")
case True
have "∃x∈cball a r ∩ s. ∀y ∈ cball a r ∩ s. f x ≤ f y"
apply (rule continuous_attains_inf) using assms True unfolding proper_def apply (auto simp add: continuous_on_subset)
using centre_in_cball by blast
then obtain x where x: "x ∈ cball a r ∩ s" "⋀y. y ∈ cball a r ∩ s ⟹ f x ≤ f y"
by auto
have "f x ≤ f y" if "y ∈ s" for y
proof (cases "y ∈ cball a r")
case True
then show ?thesis using x(2) that by auto
next
case False
have "f x ≤ f a"
apply (rule x(2)) using assms True by auto
then show ?thesis using assms(4)[of y] that False by auto
qed
then show ?thesis using x(1) by auto
next
case False
show ?thesis
apply (rule bexI[of _ a]) using assms False by auto
qed
subsubsection ‹Measure of balls›
text ‹The image of a ball by an affine map is still a ball, with explicit center and radius. (Now unused)›
lemma affine_image_ball [simp]:
"(λy. R *⇩R y + x) ` cball 0 1 = cball (x::('a::real_normed_vector)) ¦R¦"
proof
have "dist x (R *⇩R y + x) ≤ ¦R¦" if "dist 0 y ≤ 1" for y
proof -
have "dist x (R *⇩R y + x) = norm ((R *⇩R y + x) - x)" by (simp add: dist_norm)
also have "... = ¦R¦ * norm y" by auto
finally show ?thesis using that by (simp add: mult_left_le)
qed
then show "(λy. R *⇩R y + x) ` cball 0 1 ⊆ cball x ¦R¦" by auto
show "cball x ¦R¦ ⊆ (λy. R *⇩R y + x) ` cball 0 1"
proof (cases "¦R¦ = 0")
case True
then have "cball x ¦R¦ = {x}" by auto
moreover have "x = R *⇩R 0 + x ∧ 0 ∈ cball 0 1" by auto
ultimately show ?thesis by auto
next
case False
have "z ∈ (λy. R *⇩R y + x) ` cball 0 1" if "z ∈ cball x ¦R¦" for z
proof -
define y where "y = (z - x) /⇩R R"
have "R *⇩R y + x = z" unfolding y_def using False by auto
moreover have "y ∈ cball 0 1"
using ‹z ∈ cball x ¦R¦› False unfolding y_def by (auto simp add: dist_norm[symmetric] divide_simps dist_commute)
ultimately show ?thesis by auto
qed
then show ?thesis by auto
qed
qed
text ‹From the rescaling properties of Lebesgue measure in a euclidean space, it follows that
the measure of any ball can be expressed in terms of the measure of the unit ball.›
lemma lebesgue_measure_ball:
assumes "R ≥ 0"
shows "measure lborel (cball (x::('a::euclidean_space)) R) = R^(DIM('a)) * measure lborel (cball (0::'a) 1)"
"emeasure lborel (cball (x::('a::euclidean_space)) R) = R^(DIM('a)) * emeasure lborel (cball (0::'a) 1)"
apply (simp add: assms content_cball)
by (simp add: assms emeasure_cball ennreal_mult' ennreal_power mult.commute)
text ‹We show that the unit ball has positive measure -- this is obvious, but useful. We could
show it by arguing that it contains a box, whose measure can be computed, but instead we say
that if the measure vanished then the measure of any ball would also vanish, contradicting the
fact that the space has infinite measure. This avoids all computations.›
lemma lebesgue_measure_ball_pos:
"emeasure lborel (cball (0::'a::euclidean_space) 1) > 0"
"measure lborel (cball (0::'a::euclidean_space) 1) > 0"
proof -
show "emeasure lborel (cball (0::'a::euclidean_space) 1) > 0"
proof (rule ccontr)
assume "¬(emeasure lborel (cball (0::'a::euclidean_space) 1) > 0)"
then have "emeasure lborel (cball (0::'a) 1) = 0" by auto
then have "emeasure lborel (cball (0::'a) n) = 0" for n::nat
using lebesgue_measure_ball(2)[of "real n" 0] by (metis mult_zero_right of_nat_0_le_iff)
then have "emeasure lborel (⋃n. cball (0::'a) (real n)) = 0"
by (metis (mono_tags, lifting) borel_closed closed_cball emeasure_UN_eq_0 imageE sets_lborel subsetI)
moreover have "(⋃n. cball (0::'a) (real n)) = UNIV" by (auto simp add: real_arch_simple)
ultimately show False
by simp
qed
moreover have "emeasure lborel (cball (0::'a::euclidean_space) 1) < ∞"
by (rule emeasure_bounded_finite, auto)
ultimately show "measure lborel (cball (0::'a::euclidean_space) 1) > 0"
by (metis borel_closed closed_cball ennreal_0 has_integral_iff_emeasure_lborel has_integral_measure_lborel less_irrefl order_refl zero_less_measure_iff)
qed
subsubsection ‹infdist and closest point projection›
text ‹The distance to a union of two sets is the minimum of the distance to the two sets.›
lemma infdist_union_min [mono_intros]:
assumes "A ≠ {}" "B ≠ {}"
shows "infdist x (A ∪ B) = min (infdist x A) (infdist x B)"
using assms by (simp add: infdist_def cINF_union inf_real_def)
text ‹The distance to a set is non-increasing with the set.›
lemma infdist_mono [mono_intros]:
assumes "A ⊆ B" "A ≠ {}"
shows "infdist x B ≤ infdist x A"
by (simp add: assms infdist_eq_setdist setdist_subset_right)
text ‹If a set is proper, then the infimum of the distances to this set is attained.›
lemma infdist_proper_attained:
assumes "proper C" "C ≠ {}"
shows "∃c∈C. infdist x C = dist x c"
proof -
obtain a where "a ∈ C" using assms by auto
have *: "dist x a ≤ dist x z" if "dist a z ≥ 2 * dist a x" for z
proof -
have "2 * dist a x ≤ dist a z" using that by simp
also have "... ≤ dist a x + dist x z" by (intro mono_intros)
finally show ?thesis by (simp add: dist_commute)
qed
have "∃c∈C. ∀d∈C. dist x c ≤ dist x d"
apply (rule continuous_attains_inf_proper[OF assms(1) ‹a ∈ C›, of _ "2 * dist a x"])
using * by (auto intro: continuous_intros)
then show ?thesis unfolding infdist_def using ‹C ≠ {}›
by (metis antisym bdd_below_image_dist cINF_lower le_cINF_iff)
qed
lemma infdist_almost_attained:
assumes "infdist x X < a" "X ≠ {}"
shows "∃y∈X. dist x y < a"
using assms using cInf_less_iff[of "(dist x)`X"] unfolding infdist_def by auto
lemma infdist_triangle_abs [mono_intros]:
"¦infdist x A - infdist y A¦ ≤ dist x y"
by (metis (full_types) abs_diff_le_iff diff_le_eq dist_commute infdist_triangle)
text ‹The next lemma is missing in the library, contrary to its cousin \verb+continuous_infdist+.›
text ‹The infimum of the distance to a singleton set is simply the distance to the unique
member of the set.›
text ‹The closest point projection of $x$ on $A$. It is not unique, so we choose one point realizing the minimal
distance. And if there is no such point, then we use $x$, to make some statements true without any
assumption.›
definition proj_set::"'a::metric_space ⇒ 'a set ⇒ 'a set"
where "proj_set x A = {y ∈ A. dist x y = infdist x A}"
definition distproj::"'a::metric_space ⇒ 'a set ⇒ 'a"
where "distproj x A = (if proj_set x A ≠ {} then SOME y. y ∈ proj_set x A else x)"
lemma proj_setD:
assumes "y ∈ proj_set x A"
shows "y ∈ A" "dist x y = infdist x A"
using assms unfolding proj_set_def by auto
lemma proj_setI:
assumes "y ∈ A" "dist x y ≤ infdist x A"
shows "y ∈ proj_set x A"
using assms infdist_le[OF ‹y ∈ A›, of x] unfolding proj_set_def by auto
lemma proj_setI':
assumes "y ∈ A" "⋀z. z ∈ A ⟹ dist x y ≤ dist x z"
shows "y ∈ proj_set x A"
proof (rule proj_setI[OF ‹y ∈ A›])
show "dist x y ≤ infdist x A"
apply (subst infdist_notempty)
using assms by (auto intro!: cInf_greatest)
qed
lemma distproj_in_proj_set:
assumes "proj_set x A ≠ {}"
shows "distproj x A ∈ proj_set x A"
"distproj x A ∈ A"
"dist x (distproj x A) = infdist x A"
proof -
show "distproj x A ∈ proj_set x A"
using assms unfolding distproj_def using some_in_eq by auto
then show "distproj x A ∈ A" "dist x (distproj x A) = infdist x A"
unfolding proj_set_def by auto
qed
lemma proj_set_nonempty_of_proper:
assumes "proper A" "A ≠ {}"
shows "proj_set x A ≠ {}"
proof -
have "∃y. y ∈ A ∧ dist x y = infdist x A"
using infdist_proper_attained[OF assms, of x] by auto
then show "proj_set x A ≠ {}" unfolding proj_set_def by auto
qed
lemma distproj_self [simp]:
assumes "x ∈ A"
shows "proj_set x A = {x}"
"distproj x A = x"
proof -
show "proj_set x A = {x}"
unfolding proj_set_def using assms by auto
then show "distproj x A = x"
unfolding distproj_def by auto
qed
lemma distproj_closure [simp]:
assumes "x ∈ closure A"
shows "distproj x A = x"
proof (cases "proj_set x A ≠ {}")
case True
show ?thesis
using distproj_in_proj_set(3)[OF True] assms
by (metis closure_empty dist_eq_0_iff distproj_self(2) in_closure_iff_infdist_zero)
next
case False
then show ?thesis unfolding distproj_def by auto
qed
lemma distproj_le:
assumes "y ∈ A"
shows "dist x (distproj x A) ≤ dist x y"
proof (cases "proj_set x A ≠ {}")
case True
show ?thesis using distproj_in_proj_set(3)[OF True] infdist_le[OF assms] by auto
next
case False
then show ?thesis unfolding distproj_def by auto
qed
lemma proj_set_dist_le:
assumes "y ∈ A" "p ∈ proj_set x A"
shows "dist x p ≤ dist x y"
using assms infdist_le unfolding proj_set_def by auto
subsection ‹Material on ereal and ennreal›
text ‹We add the simp rules that we needed to make all computations become more or less automatic.›
lemma ereal_of_real_of_ereal_iff [simp]:
"ereal(real_of_ereal x) = x ⟷ x ≠ ∞ ∧ x ≠ - ∞"
"x = ereal(real_of_ereal x) ⟷ x ≠ ∞ ∧ x ≠ - ∞"
by (metis MInfty_neq_ereal(1) PInfty_neq_ereal(2) real_of_ereal.elims)+
declare ereal_inverse_eq_0 [simp]
declare ereal_0_gt_inverse [simp]
declare ereal_inverse_le_0_iff [simp]
declare ereal_divide_eq_0_iff [simp]
declare ereal_mult_le_0_iff [simp]
declare ereal_zero_le_0_iff [simp]
declare ereal_mult_less_0_iff [simp]
declare ereal_zero_less_0_iff [simp]
declare ereal_uminus_eq_reorder [simp]
declare ereal_minus_le_iff [simp]
lemma ereal_inverse_noteq_minus_infinity [simp]:
"1/(x::ereal) ≠ -∞"
by (simp add: divide_ereal_def)
lemma ereal_inverse_positive_iff_nonneg_not_infinity [simp]:
"0 < 1/(x::ereal) ⟷ (x ≥ 0 ∧ x ≠ ∞)"
by (cases x, auto simp add: one_ereal_def)
lemma ereal_inverse_negative_iff_nonpos_not_infinity' [simp]:
"0 > inverse (x::ereal) ⟷ (x < 0 ∧ x ≠ -∞)"
by (cases x, auto simp add: one_ereal_def)
lemma ereal_divide_pos_iff [simp]:
"0 < x/(y::ereal) ⟷ (y ≠ ∞ ∧ y ≠ -∞) ∧ ((x > 0 ∧ y > 0) ∨ (x < 0 ∧ y < 0) ∨ (y = 0 ∧ x > 0))"
unfolding divide_ereal_def by auto
lemma ereal_divide_neg_iff [simp]:
"0 > x/(y::ereal) ⟷ (y ≠ ∞ ∧ y ≠ -∞) ∧ ((x > 0 ∧ y < 0) ∨ (x < 0 ∧ y > 0) ∨ (y = 0 ∧ x < 0))"
unfolding divide_ereal_def by auto
text ‹More additions to \verb+mono_intros+.›
lemma ereal_leq_imp_neg_leq [mono_intros]:
fixes x y::ereal
assumes "x ≤ y"
shows "-y ≤ -x"
using assms by auto
lemma ereal_le_imp_neg_le [mono_intros]:
fixes x y::ereal
assumes "x < y"
shows "-y < -x"
using assms by auto
declare ereal_mult_left_mono [mono_intros]
declare ereal_mult_right_mono [mono_intros]
declare ereal_mult_strict_right_mono [mono_intros]
declare ereal_mult_strict_left_mono [mono_intros]
text ‹Monotonicity of basic inclusions.›
lemma ennreal_mono':
"mono ennreal"
by (simp add: ennreal_leI monoI)
lemma enn2ereal_mono':
"mono enn2ereal"
by (simp add: less_eq_ennreal.rep_eq mono_def)
lemma e2ennreal_mono':
"mono e2ennreal"
by (simp add: e2ennreal_mono mono_def)
lemma enn2ereal_mono [mono_intros]:
assumes "x ≤ y"
shows "enn2ereal x ≤ enn2ereal y"
using assms less_eq_ennreal.rep_eq by auto
lemma ereal_mono:
"mono ereal"
unfolding mono_def by auto
lemma ereal_strict_mono:
"strict_mono ereal"
unfolding strict_mono_def by auto
lemma ereal_mono2 [mono_intros]:
assumes "x ≤ y"
shows "ereal x ≤ ereal y"
by (simp add: assms)
lemma ereal_strict_mono2 [mono_intros]:
assumes "x < y"
shows "ereal x < ereal y"
using assms by auto
lemma enn2ereal_a_minus_b_plus_b [mono_intros]:
"enn2ereal a ≤ enn2ereal (a - b) + enn2ereal b"
by (metis diff_add_self_ennreal less_eq_ennreal.rep_eq linear plus_ennreal.rep_eq)
text ‹The next lemma follows from the same assertion in ereals.›
lemma enn2ereal_strict_mono [mono_intros]:
assumes "x < y"
shows "enn2ereal x < enn2ereal y"
using assms less_ennreal.rep_eq by auto
declare ennreal_mult_strict_left_mono [mono_intros]
declare ennreal_mult_strict_right_mono [mono_intros]
lemma ennreal_ge_0 [mono_intros]:
assumes "0 < x"
shows "0 < ennreal x"
by (simp add: assms)
text ‹The next lemma is true and useful in ereal. Note that variants such as $a + b \leq c + d$
implies $a-d \leq c -b$ are not true -- take $a = c = \infty$ and $b = d = 0$...›
lemma ereal_minus_le_minus_plus [mono_intros]:
fixes a b c::ereal
assumes "a ≤ b + c"
shows "-b ≤ -a + c"
using assms apply (cases a, cases b, cases c, auto)
using ereal_infty_less_eq2(2) ereal_plus_1(4) by fastforce
lemma tendsto_ennreal_0 [tendsto_intros]:
assumes "(u ⤏ 0) F"
shows "((λn. ennreal(u n)) ⤏ 0) F"
unfolding ennreal_0[symmetric] by (intro tendsto_intros assms)
lemma tendsto_ennreal_1 [tendsto_intros]:
assumes "(u ⤏ 1) F"
shows "((λn. ennreal(u n)) ⤏ 1) F"
unfolding ennreal_1[symmetric] by (intro tendsto_intros assms)
subsection ‹Miscellaneous›
lemma lim_ceiling_over_n [tendsto_intros]:
assumes "(λn. u n/n) ⇢ l"
shows "(λn. ceiling(u n)/n) ⇢ l"
proof (rule tendsto_sandwich[of "λn. u n/n" _ _ "λn. u n/n + 1/n"])
show "∀⇩F n in sequentially. u n / real n ≤ real_of_int ⌈u n⌉ / real n"
unfolding eventually_sequentially by (rule exI[of _ 1], auto simp add: divide_simps)
show "∀⇩F n in sequentially. real_of_int ⌈u n⌉ / real n ≤ u n / real n + 1 / real n"
unfolding eventually_sequentially by (rule exI[of _ 1], auto simp add: divide_simps)
have "(λn. u n / real n + 1 / real n) ⇢ l + 0"
by (intro tendsto_intros assms)
then show "(λn. u n / real n + 1 / real n) ⇢ l" by auto
qed (simp add: assms)
subsubsection ‹Liminfs and Limsups›
text ‹More facts on liminfs and limsups›
lemma Limsup_obtain':
fixes u::"'a ⇒ 'b::complete_linorder"
assumes "Limsup F u > c" "eventually P F"
shows "∃n. P n ∧ u n > c"
proof -
have *: "(INF P∈{P. eventually P F}. SUP x∈{x. P x}. u x) > c" using assms by (simp add: Limsup_def)
have **: "c < (SUP x∈{x. P x}. u x)" using less_INF_D[OF *, of P] assms by auto
then show ?thesis by (simp add: less_SUP_iff)
qed
lemma limsup_obtain:
fixes u::"nat ⇒ 'a :: complete_linorder"
assumes "limsup u > c"
shows "∃n ≥ N. u n > c"
using Limsup_obtain'[OF assms, of "λn. n ≥ N"] unfolding eventually_sequentially by auto
lemma Liminf_obtain':
fixes u::"'a ⇒ 'b::complete_linorder"
assumes "Liminf F u < c" "eventually P F"
shows "∃n. P n ∧ u n < c"
proof -
have *: "(SUP P∈{P. eventually P F}. INF x∈{x. P x}. u x) < c" using assms by (simp add: Liminf_def)
have **: "(INF x∈{x. P x}. u x) < c" using SUP_lessD[OF *, of P] assms by auto
then show ?thesis by (simp add: INF_less_iff)
qed
lemma liminf_obtain:
fixes u::"nat ⇒ 'a :: complete_linorder"
assumes "liminf u < c"
shows "∃n ≥ N. u n < c"
using Liminf_obtain'[OF assms, of "λn. n ≥ N"] unfolding eventually_sequentially by auto
text ‹The Liminf of a minimum is the minimum of the Liminfs.›
lemma Liminf_min_eq_min_Liminf:
fixes u v::"nat ⇒ 'a::complete_linorder"
shows "Liminf F (λn. min (u n) (v n)) = min (Liminf F u) (Liminf F v)"
proof (rule order_antisym)
show "Liminf F (λn. min (u n) (v n)) ≤ min (Liminf F u) (Liminf F v)"
by (auto simp add: Liminf_mono)
have "Liminf F (λn. min (u n) (v n)) > w" if H: "min (Liminf F u) (Liminf F v) > w" for w
proof (cases "{w<..<min (Liminf F u) (Liminf F v)} = {}")
case True
have "eventually (λn. u n > w) F" "eventually (λn. v n > w) F"
using H le_Liminf_iff by fastforce+
then have "eventually (λn. min (u n) (v n) > w) F"
apply auto using eventually_elim2 by fastforce
moreover have "z > w ⟹ z ≥ min (Liminf F u) (Liminf F v)" for z
using H True not_le_imp_less by fastforce
ultimately have "eventually (λn. min (u n) (v n) ≥ min (Liminf F u) (Liminf F v)) F"
by (simp add: eventually_mono)
then have "min (Liminf F u) (Liminf F v) ≤ Liminf F (λn. min (u n) (v n))"
by (metis Liminf_bounded)
then show ?thesis using H less_le_trans by blast
next
case False
then obtain z where "z ∈ {w<..<min (Liminf F u) (Liminf F v)}"
by blast
then have H: "w < z" "z < min (Liminf F u) (Liminf F v)"
by auto
then have "eventually (λn. u n > z) F" "eventually (λn. v n > z) F"
using le_Liminf_iff by fastforce+
then have "eventually (λn. min (u n) (v n) > z) F"
apply auto using eventually_elim2 by fastforce
then have "Liminf F (λn. min (u n) (v n)) ≥ z"
by (simp add: Liminf_bounded eventually_mono less_imp_le)
then show ?thesis using H(1)
by auto
qed
then show "min (Liminf F u) (Liminf F v) ≤ Liminf F (λn. min (u n) (v n))"
using not_le_imp_less by blast
qed
text ‹The Limsup of a maximum is the maximum of the Limsups.›
lemma Limsup_max_eq_max_Limsup:
fixes u::"'a ⇒ 'b::complete_linorder"
shows "Limsup F (λn. max (u n) (v n)) = max (Limsup F u) (Limsup F v)"
proof (rule order_antisym)
show "max (Limsup F u) (Limsup F v) ≤ Limsup F (λn. max (u n) (v n))"
by (auto intro: Limsup_mono)
have "Limsup F (λn. max (u n) (v n)) < e" if "max (Limsup F u) (Limsup F v) < e" for e
proof (cases "∃t. max (Limsup F u) (Limsup F v) < t ∧ t < e")
case True
then obtain t where t: "t < e" "max (Limsup F u) (Limsup F v) < t" by auto
then have "Limsup F u < t" "Limsup F v < t" using that max_def by auto
then have *: "eventually (λn. u n < t) F" "eventually (λn. v n < t) F"
by (auto simp: Limsup_lessD)
have "eventually (λn. max (u n) (v n) < t) F"
using eventually_mono[OF eventually_conj[OF *]] by auto
then have "Limsup F (λn. max (u n) (v n)) ≤ t"
by (meson Limsup_obtain' not_le_imp_less order.asym)
then show ?thesis
using t by auto
next
case False
have "Limsup F u < e" "Limsup F v < e" using that max_def by auto
then have *: "eventually (λn. u n < e) F" "eventually (λn. v n < e) F"
by (auto simp: Limsup_lessD)
have "eventually (λn. max (u n) (v n) ≤ max (Limsup F u) (Limsup F v)) F"
apply (rule eventually_mono[OF eventually_conj[OF *]]) using False not_le_imp_less by force
then have "Limsup F (λn. max (u n) (v n)) ≤ max (Limsup F u) (Limsup F v)"
by (meson Limsup_obtain' leD leI)
then show ?thesis using that le_less_trans by blast
qed
then show "Limsup F (λn. max (u n) (v n)) ≤ max (Limsup F u) (Limsup F v)"
using not_le_imp_less by blast
qed
subsubsection ‹Bounding the cardinality of a finite set›
text ‹A variation with real bounds.›
lemma finite_finite_subset_caract':
fixes C::real
assumes "⋀G. G ⊆ F ⟹ finite G ⟹ card G ≤ C"
shows "finite F ∧ card F ≤ C"
by (meson assms finite_if_finite_subsets_card_bdd le_nat_floor order_refl)
text ‹To show that a set has cardinality at most one, it suffices to show that any two of its
elements coincide.›
lemma finite_at_most_singleton:
assumes "⋀x y. x ∈ F ⟹ y ∈ F ⟹ x = y"
shows "finite F ∧ card F ≤ 1"
proof (cases "F = {}")
case True
then show ?thesis by auto
next
case False
then obtain x where "x ∈ F" by auto
then have "F = {x}" using assms by auto
then show ?thesis by auto
qed
text ‹Bounded sets of integers are finite.›
lemma finite_real_int_interval [simp]:
"finite (range real_of_int ∩ {a..b})"
proof -
have "range real_of_int ∩ {a..b} ⊆ real_of_int`{floor a..ceiling b}"
by (auto, metis atLeastAtMost_iff ceiling_mono ceiling_of_int floor_mono floor_of_int image_eqI)
then show ?thesis using finite_subset by blast
qed
text ‹Well separated sets of real numbers are finite, with controlled cardinality.›
lemma separated_in_real_card_bound:
assumes "T ⊆ {a..(b::real)}" "d > 0" "⋀x y. x ∈ T ⟹ y ∈ T ⟹ y > x ⟹ y ≥ x + d"
shows "finite T" "card T ≤ nat (floor ((b-a)/d) + 1)"
proof -
define f where "f = (λx. floor ((x-a) / d))"
have "f`{a..b} ⊆ {0..floor ((b-a)/d)}"
unfolding f_def using ‹d > 0› by (auto simp add: floor_mono frac_le)
then have *: "f`T ⊆ {0..floor ((b-a)/d)}" using ‹T ⊆ {a..b}› by auto
then have "finite (f`T)" by (rule finite_subset, auto)
have "card (f`T) ≤ card {0..floor ((b-a)/d)}" apply (rule card_mono) using * by auto
then have card_le: "card (f`T) ≤ nat (floor ((b-a)/d) + 1)" using card_atLeastAtMost_int by auto
have *: "f x ≠ f y" if "y ≥ x + d" for x y
proof -
have "(y-a)/d ≥ (x-a)/d + 1" using ‹d > 0› that by (auto simp add: divide_simps)
then show ?thesis unfolding f_def by linarith
qed
have "inj_on f T"
unfolding inj_on_def using * assms(3) by (auto, metis not_less_iff_gr_or_eq)
show "finite T"
using ‹finite (f`T)› ‹inj_on f T› finite_image_iff by blast
have "card T = card (f`T)"
using ‹inj_on f T› by (simp add: card_image)
then show "card T ≤ nat (floor ((b-a)/d) + 1)"
using card_le by auto
qed
subsection ‹Manipulating finite ordered sets›
text ‹We will need below to construct finite sets of real numbers with good properties expressed
in terms of consecutive elements of the set. We introduce tools to manipulate such sets,
expressing in particular the next and the previous element of the set and controlling how they
evolve when one inserts a new element in the set. It works in fact in any linorder, and could
also prove useful to construct sets of integer numbers.
Manipulating the next and previous elements work well, except at the top (respectively bottom).
In our constructions, these will be fixed and called $b$ and $a$.›
text ‹Notations for the next and the previous elements.›
definition next_in::"'a set ⇒ 'a ⇒ ('a::linorder)"
where "next_in A u = Min (A ∩ {u<..})"
definition prev_in::"'a set ⇒ 'a ⇒ ('a::linorder)"
where "prev_in A u = Max (A ∩ {..<u})"
context
fixes A::"('a::linorder) set" and a b::'a
assumes A: "finite A" "A ⊆ {a..b}" "a ∈ A" "b ∈ A" "a < b"
begin
text ‹Basic properties of the next element, when one starts from an element different from top.›
lemma next_in_basics:
assumes "u ∈ {a..<b}"
shows "next_in A u ∈ A"
"next_in A u > u"
"A ∩ {u<..<next_in A u} = {}"
proof -
have next_in_A: "next_in A u ∈ A ∩ {u<..}"
unfolding next_in_def apply (rule Min_in)
using assms ‹finite A› ‹b ∈ A› by auto
then show "next_in A u ∈ A" "next_in A u > u" by auto
show "A ∩ {u<..<next_in A u} = {}"
unfolding next_in_def using A by (auto simp add: leD)
qed
lemma next_inI:
assumes "u ∈ {a..<b}"
"v ∈ A"
"v > u"
"{u<..<v} ∩ A = {}"
shows "next_in A u = v"
using assms next_in_basics[OF ‹u ∈ {a..<b}›] by fastforce
text ‹Basic properties of the previous element, when one starts from an element different from
bottom.›
lemma prev_in_basics:
assumes "u ∈ {a<..b}"
shows "prev_in A u ∈ A"
"prev_in A u < u"
"A ∩ {prev_in A u<..<u} = {}"
proof -
have prev_in_A: "prev_in A u ∈ A ∩ {..<u}"
unfolding prev_in_def apply (rule Max_in)
using assms ‹finite A› ‹a ∈ A› by auto
then show "prev_in A u ∈ A" "prev_in A u < u" by auto
show "A ∩ {prev_in A u<..<u} = {}"
unfolding prev_in_def using A by (auto simp add: leD)
qed
lemma prev_inI:
assumes "u ∈ {a<..b}"
"v ∈ A"
"v < u"
"{v<..<u} ∩ A = {}"
shows "prev_in A u = v"
using assms prev_in_basics[OF ‹u ∈ {a<..b}›]
by (meson disjoint_iff_not_equal greaterThanLessThan_iff less_linear)
text ‹The interval $[a,b]$ is covered by the intervals between the consecutive elements of $A$.›
lemma intervals_decomposition:
"(⋃ U ∈ {{u..next_in A u} | u. u ∈ A - {b}}. U) = {a..b}"
proof
show "(⋃U∈{{u..next_in A u} |u. u ∈ A - {b}}. U) ⊆ {a..b}"
using ‹A ⊆ {a..b}› next_in_basics(1) apply auto apply fastforce
by (metis ‹A ⊆ {a..b}› atLeastAtMost_iff eq_iff le_less_trans less_eq_real_def not_less subset_eq subset_iff_psubset_eq)
have "x ∈ (⋃U∈{{u..next_in A u} |u. u ∈ A - {b}}. U)" if "x ∈ {a..b}" for x
proof -
consider "x = b" | "x ∈ A - {b}" | "x ∉ A" by blast
then show ?thesis
proof(cases)
case 1
define u where "u = prev_in A b"
have "b ∈ {a<..b}" using ‹a < b› by simp
have "u ∈ A - {b}" unfolding u_def using prev_in_basics[OF ‹b ∈ {a<..b}›] by simp
then have "u ∈ {a..<b}" using ‹A ⊆ {a..b}› ‹a < b› by fastforce
have "next_in A u = b"
using prev_in_basics[OF ‹b ∈ {a<..b}›] next_in_basics[OF ‹u ∈ {a..<b}›] ‹A ⊆ {a..b}› unfolding u_def by force
then have "x ∈ {u..next_in A u}" unfolding 1 using prev_in_basics[OF ‹b ∈ {a<..b}›] u_def by auto
then show ?thesis using ‹u ∈ A - {b}› by auto
next
case 2
then have "x ∈ {a..<b}" using ‹A ⊆ {a..b}› ‹a < b› by fastforce
have "x ∈ {x.. next_in A x}" using next_in_basics[OF ‹x ∈ {a..<b}›] by auto
then show ?thesis using 2 by auto
next
case 3
then have "x ∈ {a<..b}" using that ‹a ∈ A› leI by fastforce
define u where "u = prev_in A x"
have "u ∈ A - {b}" unfolding u_def using prev_in_basics[OF ‹x ∈ {a<..b}›] that by auto
then have "u ∈ {a..<b}" using ‹A ⊆ {a..b}› ‹a < b› by fastforce
have "x ∈ {u..next_in A u}"
using prev_in_basics[OF ‹x ∈ {a<..b}›] next_in_basics[OF ‹u ∈ {a..<b}›] unfolding u_def by auto
then show ?thesis using ‹u ∈ A - {b}› by auto
qed
qed
then show "{a..b} ⊆ (⋃U∈{{u..next_in A u} |u. u ∈ A - {b}}. U)" by auto
qed
end
text ‹If one inserts an additional element, then next and previous elements are not modified,
except at the location of the insertion.›
lemma next_in_insert:
assumes A: "finite A" "A ⊆ {a..b}" "a ∈ A" "b ∈ A" "a < b"
and "x ∈ {a..b} - A"
shows "⋀u. u ∈ A - {b, prev_in A x} ⟹ next_in (insert x A) u = next_in A u"
"next_in (insert x A) x = next_in A x"
"next_in (insert x A) (prev_in A x) = x"
proof -
define B where "B = insert x A"
have B: "finite B" "B ⊆ {a..b}" "a ∈ B" "b ∈ B" "a < b"
using assms unfolding B_def by auto
have x: "x ∈ {a..<b}" "x ∈ {a<..b}" using assms leI by fastforce+
show "next_in B x = next_in A x"
unfolding B_def by (auto simp add: next_in_def)
show "next_in B (prev_in A x) = x"
apply (rule next_inI[OF B])
unfolding B_def using prev_in_basics[OF A ‹x ∈ {a<..b}›] ‹A ⊆ {a..b}› x by auto
fix u assume "u ∈ A - {b, prev_in A x}"
then have "u ∈ {a..<b}" using assms by fastforce
have "x ∉ {u<..<next_in A u}"
proof (rule ccontr)
assume "¬(x ∉ {u<..<next_in A u})"
then have *: "x ∈ {u<..<next_in A u}" by auto
have "prev_in A x = u"
apply (rule prev_inI[OF A ‹x ∈ {a<..b}›])
using ‹u ∈ A - {b, prev_in A x}› * next_in_basics[OF A ‹u ∈ {a..<b}›] apply auto
by (meson disjoint_iff_not_equal greaterThanLessThan_iff less_trans)
then show False using ‹u ∈ A - {b, prev_in A x}› by auto
qed
show "next_in B u = next_in A u"
apply (rule next_inI[OF B ‹u ∈ {a..<b}›]) unfolding B_def
using next_in_basics[OF A ‹u ∈ {a..<b}›] ‹x ∉ {u<..<next_in A u}› by auto
qed
text ‹If consecutive elements are enough separated, this implies a simple bound on the
cardinality of the set.›
lemma separated_in_real_card_bound2:
fixes A::"real set"
assumes A: "finite A" "A ⊆ {a..b}" "a ∈ A" "b ∈ A" "a < b"
and B: "⋀u. u ∈ A - {b} ⟹ next_in A u ≥ u + d" "d > 0"
shows "card A ≤ nat (floor ((b-a)/d) + 1)"
proof (rule separated_in_real_card_bound[OF ‹A ⊆ {a..b}› ‹d > 0›])
fix x y assume "x ∈ A" "y ∈ A" "y > x"
then have "x ∈ A - {b}" "x ∈ {a..<b}" using ‹A ⊆ {a..b}› by auto
have "y ≥ next_in A x"
using next_in_basics[OF A ‹x ∈ {a..<b}›] ‹y ∈ A› ‹y > x› by auto
then show "y ≥ x + d" using B(1)[OF ‹x ∈ A - {b}›] by auto
qed
subsection ‹Well-orders›
text ‹In this subsection, we give additional lemmas on well-orders or cardinals or whatever,
that would well belong to the library, and will be needed below.›
lemma (in wo_rel) max2_underS [simp]:
assumes "x ∈ underS z" "y ∈ underS z"
shows "max2 x y ∈ underS z"
using assms max2_def by auto
lemma (in wo_rel) max2_underS' [simp]:
assumes "x ∈ underS y"
shows "max2 x y = y" "max2 y x = y"
apply (simp add: underS_E assms max2_def)
using assms max2_def ANTISYM antisym_def underS_E by fastforce
lemma (in wo_rel) max2_xx [simp]:
"max2 x x = x"
using max2_def by auto
declare underS_notIn [simp]
text ‹The abbrevation $=o$ is used both in \verb+Set_Algebras+ and Cardinals.
We disable the one from \verb+Set_Algebras+.›
no_notation elt_set_eq (infix "=o" 50)
lemma regularCard_ordIso:
assumes "Card_order r" "regularCard r" "s =o r"
shows "regularCard s"
unfolding regularCard_def
proof (auto)
fix K assume K: "K ⊆ Field s" "cofinal K s"
obtain f where f: "bij_betw f (Field s) (Field r)" "embed s r f" using ‹s =o r› unfolding ordIso_def iso_def by auto
have "f`K ⊆ Field r" using K(1) f(1) bij_betw_imp_surj_on by blast
have "cofinal (f`K) r" unfolding cofinal_def
proof
fix a assume "a ∈ Field r"
then obtain a' where a: "a' ∈ Field s" "f a' = a" using f
by (metis bij_betw_imp_surj_on imageE)
then obtain b' where b: "b' ∈ K" "a' ≠ b' ∧ (a', b') ∈ s"
using ‹cofinal K s› unfolding cofinal_def by auto
have P1: "f b' ∈ f`K" using b(1) by auto
have "a' ≠ b'" "a' ∈ Field s" "b' ∈ Field s" using a(1) b K(1) by auto
then have P2: "a ≠ f b'" unfolding a(2)[symmetric] using f(1) unfolding bij_betw_def inj_on_def by auto
have "(a', b') ∈ s" using b by auto
then have P3: "(a, f b') ∈ r" unfolding a(2)[symmetric] using f
by (meson FieldI1 FieldI2 Card_order_ordIso[OF assms(1) assms(3)] card_order_on_def iso_defs(1) iso_iff2)
show "∃b∈f ` K. a ≠ b ∧ (a, b) ∈ r"
using P1 P2 P3 by blast
qed
then have "|f`K| =o r"
using ‹regularCard r› ‹f`K ⊆ Field r› unfolding regularCard_def by auto
moreover have "|f`K| =o |K|" using f(1) K(1)
by (meson bij_betw_subset card_of_ordIsoI ordIso_symmetric)
ultimately show "|K| =o s"
using ‹s =o r› by (meson ordIso_symmetric ordIso_transitive)
qed
lemma AboveS_not_empty_in_regularCard:
assumes "|S| <o r" "S ⊆ Field r"
assumes r: "Card_order r" "regularCard r" "¬finite (Field r)"
shows "AboveS r S ≠ {}"
proof -
have "¬(cofinal S r)"
using assms not_ordLess_ordIso unfolding regularCard_def by auto
then obtain a where a: "a ∈ Field r" "∀b∈S. ¬(a ≠ b ∧ (a,b) ∈ r)"
unfolding cofinal_def by auto
have *: "a = b ∨ (b, a) ∈ r" if "b ∈ S" for b
proof -
have "a = b ∨ (a,b) ∉ r" using a that by auto
then show ?thesis
using ‹Card_order r› ‹a ∈ Field r› ‹b ∈ S› ‹S ⊆ Field r› unfolding card_order_on_def well_order_on_def linear_order_on_def total_on_def
by auto
qed
obtain c where "c ∈ Field r" "c ≠ a" "(a, c) ∈ r"
using a(1) r infinite_Card_order_limit by fastforce
then have "c ∈ AboveS r S"
unfolding AboveS_def apply simp using Card_order_trans[OF r(1)] by (metis *)
then show ?thesis by auto
qed
lemma AboveS_not_empty_in_regularCard':
assumes "|S| <o r" "f`S ⊆ Field r" "T ⊆ S"
assumes r: "Card_order r" "regularCard r" "¬finite (Field r)"
shows "AboveS r (f`T) ≠ {}"
proof -
have "|f`T| ≤o |T|" by simp
moreover have "|T| ≤o |S|" using ‹T ⊆ S› by simp
ultimately have *: "|f`T| <o r" using ‹|S| <o r› by (meson ordLeq_ordLess_trans)
show ?thesis using AboveS_not_empty_in_regularCard[OF * _ r] ‹T ⊆ S› ‹f`S ⊆ Field r› by auto
qed
lemma Well_order_extend:
assumes WELL: "well_order_on A r" and SUB: "A ⊆ B"
shows "∃r'. well_order_on B r' ∧ r ⊆ r'"
proof-
have r: "Well_order r ∧ Field r = A" using WELL well_order_on_Well_order by blast
let ?C = "B - A"
obtain r'' where "well_order_on ?C r''" using well_order_on by blast
then have r'': "Well_order r'' ∧ Field r'' = ?C"
using well_order_on_Well_order by blast
let ?r' = "r Osum r''"
have "Field r Int Field r'' = {}" using r r'' by auto
then have "r ≤o ?r'" using Osum_ordLeq[of r r''] r r'' by blast
then have "Well_order ?r'" unfolding ordLeq_def by auto
moreover have "Field ?r' = B" using r r'' SUB by (auto simp add: Field_Osum)
ultimately have "well_order_on B ?r'" by auto
moreover have "r ⊆ ?r'" by (simp add: Osum_def subrelI)
ultimately show ?thesis by blast
qed
text ‹The next lemma shows that, if the range of a function is endowed with a wellorder,
then one can pull back this wellorder by the function, and then extend it in the fibers
of the function in order to keep the wellorder property.
The proof is done by taking an arbitrary family of wellorders on each of the fibers, and using
the lexicographic order: one has $x < y$ if $f x < f y$, or if $f x = f y$ and, in the corresponding
fiber of $f$, one has $x < y$.
To formalize it, it is however more efficient to use one single wellorder, and restrict it
to each fiber.›
lemma Well_order_pullback:
assumes "Well_order r"
shows "∃s. Well_order s ∧ Field s = UNIV ∧ (∀x y. (f x, f y) ∈ (r-Id) ⟶ (x, y) ∈ s)"
proof -
obtain r2 where r2: "Well_order r2" "Field r2 = UNIV" "r ⊆ r2"
using Well_order_extend[OF assms, of UNIV] well_order_on_Well_order by auto
obtain s2 where s2: "Well_order s2" "Field s2 = (UNIV::'b set)"
by (meson well_ordering)
have r2s2:
"⋀x y z. (x, y) ∈ s2 ⟹ (y, z) ∈ s2 ⟹ (x, z) ∈ s2"
"⋀x. (x, x) ∈ s2"
"⋀x y. (x, y) ∈ s2 ∨ (y, x) ∈ s2"
"⋀x y. (x, y) ∈ s2 ⟹ (y, x) ∈ s2 ⟹ x = y"
"⋀x y z. (x, y) ∈ r2 ⟹ (y, z) ∈ r2 ⟹ (x, z) ∈ r2"
"⋀x. (x, x) ∈ r2"
"⋀x y. (x, y) ∈ r2 ∨ (y, x) ∈ r2"
"⋀x y. (x, y) ∈ r2 ⟹ (y, x) ∈ r2 ⟹ x = y"
using r2 s2 unfolding well_order_on_def linear_order_on_def partial_order_on_def total_on_def preorder_on_def antisym_def refl_on_def trans_def
by (metis UNIV_I)+
define s where "s = {(x,y). (f x, f y) ∈ r2 ∧ (f x = f y ⟶ (x, y) ∈ s2)}"
have "linear_order s"
unfolding linear_order_on_def partial_order_on_def preorder_on_def
proof (auto)
show "total_on UNIV s"
unfolding s_def apply (rule total_onI, auto) using r2s2 by metis+
show "refl_on UNIV s"
unfolding s_def apply (rule refl_onI, auto) using r2s2 by blast+
show "trans s"
unfolding s_def apply (rule transI, auto) using r2s2 by metis+
show "antisym s"
unfolding s_def apply (rule antisymI, auto) using r2s2 by metis+
qed
moreover have "wf (s - Id)"
proof (rule wfI_min)
fix x::'b and Q assume "x ∈ Q"
obtain z' where z': "z' ∈ f`Q" "⋀y. (y, z') ∈ r2 - Id ⟶ y ∉ f`Q"
proof (rule wfE_min[of "r2-Id" "f x" "f`Q"], auto)
show "wf(r2-Id)" using ‹Well_order r2› unfolding well_order_on_def by auto
show "f x ∈ f`Q" using ‹x ∈ Q› by auto
qed
define Q2 where "Q2 = Q ∩ f-`{z'}"
obtain z where z: "z ∈ Q2" "⋀y. (y, z) ∈ s2 - Id ⟶ y ∉ Q2"
proof (rule wfE_min'[of "s2-Id" "Q2"], auto)
show "wf(s2-Id)" using ‹Well_order s2› unfolding well_order_on_def by auto
assume "Q2 = {}"
then show False unfolding Q2_def using ‹z' ∈ f`Q› by blast
qed
have "(y, z) ∈ (s-Id) ⟹ y ∉ Q" for y
unfolding s_def using z' z Q2_def by auto
then show "∃z∈Q. ∀y. (y, z) ∈ s - Id ⟶ y ∉ Q"
using ‹z ∈ Q2› Q2_def by auto
qed
ultimately have "well_order_on UNIV s" unfolding well_order_on_def by simp
moreover have "(f x, f y) ∈ (r-Id) ⟶ (x, y) ∈ s" for x y
unfolding s_def using ‹r ⊆ r2› by auto
ultimately show ?thesis using well_order_on_Well_order by metis
qed
end
Theory Eexp_Eln
section ‹The exponential on extended real numbers.›
theory Eexp_Eln
imports Library_Complements
begin
text ‹To define the distance on the Gromov completion of hyperbolic spaces, we need to use
the exponential on extended real numbers. We can not use the symbol \verb+exp+, as this symbol
is already used in Banach algebras, so we use \verb+ennexp+ instead. We prove its basic
properties (together with properties of the logarithm) here. We also use it to define the square
root on ennreal. Finally, we also define versions from ereal to ereal.›
function ennexp::"ereal ⇒ ennreal" where
"ennexp (ereal r) = ennreal (exp r)"
| "ennexp (∞) = ∞"
| "ennexp (-∞) = 0"
by (auto intro: ereal_cases)
termination by standard (rule wf_empty)
lemma ennexp_0 [simp]:
"ennexp 0 = 1"
by (auto simp add: zero_ereal_def one_ennreal_def)
function eln::"ennreal ⇒ ereal" where
"eln (ennreal r) = (if r ≤ 0 then -∞ else ereal (ln r))"
| "eln (∞) = ∞"
by (auto intro: ennreal_cases, metis ennreal_eq_0_iff, simp add: ennreal_neg)
termination by standard (rule wf_empty)
lemma eln_simps [simp]:
"eln 0 = -∞"
"eln 1 = 0"
"eln top = ∞"
apply (simp only: eln.simps ennreal_0[symmetric], simp)
apply (simp only: eln.simps ennreal_1[symmetric], simp)
using eln.simps(2) by auto
lemma eln_real_pos:
assumes "r > 0"
shows "eln (ennreal r) = ereal (ln r)"
using eln.simps assms by auto
lemma eln_ennexp [simp]:
"eln (ennexp x) = x"
apply (cases x) using eln.simps by auto
lemma ennexp_eln [simp]:
"ennexp (eln x) = x"
apply (cases x) using eln.simps by auto
lemma ennexp_strict_mono:
"strict_mono ennexp"
proof -
have "ennexp x < ennexp y" if "x < y" for x y
apply (cases x, cases y)
using that apply (auto simp add: ennreal_less_iff)
by (cases y, auto)
then show ?thesis unfolding strict_mono_def by auto
qed
lemma ennexp_mono:
"mono ennexp"
using ennexp_strict_mono by (simp add: strict_mono_mono)
lemma ennexp_strict_mono2 [mono_intros]:
assumes "x < y"
shows "ennexp x < ennexp y"
using ennexp_strict_mono assms unfolding strict_mono_def by auto
lemma ennexp_mono2 [mono_intros]:
assumes "x ≤ y"
shows "ennexp x ≤ ennexp y"
using ennexp_mono assms unfolding mono_def by auto
lemma ennexp_le1 [simp]:
"ennexp x ≤ 1 ⟷ x ≤ 0"
by (metis ennexp_0 ennexp_mono2 ennexp_strict_mono eq_iff le_cases strict_mono_eq)
lemma ennexp_ge1 [simp]:
"ennexp x ≥ 1 ⟷ x ≥ 0"
by (metis ennexp_0 ennexp_mono2 ennexp_strict_mono eq_iff le_cases strict_mono_eq)
lemma eln_strict_mono:
"strict_mono eln"
by (metis ennexp_eln strict_monoI ennexp_strict_mono strict_mono_less)
lemma eln_mono:
"mono eln"
using eln_strict_mono by (simp add: strict_mono_mono)
lemma eln_strict_mono2 [mono_intros]:
assumes "x < y"
shows "eln x < eln y"
using eln_strict_mono assms unfolding strict_mono_def by auto
lemma eln_mono2 [mono_intros]:
assumes "x ≤ y"
shows "eln x ≤ eln y"
using eln_mono assms unfolding mono_def by auto
lemma eln_le0 [simp]:
"eln x ≤ 0 ⟷ x ≤ 1"
by (metis ennexp_eln ennexp_le1)
lemma eln_ge0 [simp]:
"eln x ≥ 0 ⟷ x ≥ 1"
by (metis ennexp_eln ennexp_ge1)
lemma bij_ennexp:
"bij ennexp"
by (auto intro!: bij_betw_byWitness[of _ eln])
lemma bij_eln:
"bij eln"
by (auto intro!: bij_betw_byWitness[of _ ennexp])
lemma ennexp_continuous:
"continuous_on UNIV ennexp"
apply (rule continuous_onI_mono)
using ennexp_mono unfolding mono_def by (auto simp add: bij_ennexp bij_is_surj)
lemma ennexp_tendsto [tendsto_intros]:
assumes "((λn. u n) ⤏ l) F"
shows "((λn. ennexp(u n)) ⤏ ennexp l) F"
using ennexp_continuous assms by (metis UNIV_I continuous_on tendsto_compose)
lemma eln_continuous:
"continuous_on UNIV eln"
apply (rule continuous_onI_mono)
using eln_mono unfolding mono_def by (auto simp add: bij_eln bij_is_surj)
lemma eln_tendsto [tendsto_intros]:
assumes "((λn. u n) ⤏ l) F"
shows "((λn. eln(u n)) ⤏ eln l) F"
using eln_continuous assms by (metis UNIV_I continuous_on tendsto_compose)
lemma ennexp_special_values [simp]:
"ennexp x = 0 ⟷ x = -∞"
"ennexp x = 1 ⟷ x = 0"
"ennexp x = ∞ ⟷ x = ∞"
"ennexp x = top ⟷ x = ∞"
by auto (metis eln_ennexp eln_simps)+
lemma eln_special_values [simp]:
"eln x = -∞ ⟷ x = 0"
"eln x = 0 ⟷ x = 1"
"eln x = ∞ ⟷ x = ∞"
apply auto
apply (metis ennexp.simps ennexp_eln ennexp_0)+
by (metis ennexp.simps(2) ennexp_eln infinity_ennreal_def)
lemma ennexp_add_mult:
assumes "¬((a = ∞ ∧ b = -∞) ∨ (a = -∞ ∧ b = ∞))"
shows "ennexp(a+b) = ennexp a * ennexp b"
apply (cases a, cases b)
using assms by (auto simp add: ennreal_mult'' exp_add ennreal_top_eq_mult_iff)
lemma eln_mult_add:
assumes "¬((a = ∞ ∧ b = 0) ∨ (a = 0 ∧ b = ∞))"
shows "eln(a * b) = eln a + eln b"
by (smt assms ennexp.simps(2) ennexp.simps(3) ennexp_add_mult ennexp_eln eln_ennexp)
text ‹We can also define the square root on ennreal using the above exponential.›
definition ennsqrt::"ennreal ⇒ ennreal"
where "ennsqrt x = ennexp(eln x/2)"
lemma ennsqrt_square [simp]:
"(ennsqrt x) * (ennsqrt x) = x"
proof -
have "y/2 + y/2 = y" for y::ereal
by (cases y, auto)
then show ?thesis
unfolding ennsqrt_def by (subst ennexp_add_mult[symmetric], auto)
qed
lemma ennsqrt_simps [simp]:
"ennsqrt 0 = 0"
"ennsqrt 1 = 1"
"ennsqrt ∞ = ∞"
"ennsqrt top = top"
unfolding ennsqrt_def by auto
lemma ennsqrt_mult:
"ennsqrt(a * b) = ennsqrt a * ennsqrt b"
proof -
have [simp]: "z/ereal 2 = -∞ ⟷ z = -∞" for z
by (auto simp add: ereal_divide_eq)
consider "a = 0" | "b = 0" | "a > 0 ∧ b > 0"
using zero_less_iff_neq_zero by auto
then show ?thesis
apply (cases, auto)
apply (cases a, cases b, auto simp add: ennreal_mult_top ennreal_top_mult)
unfolding ennsqrt_def apply (subst ennexp_add_mult[symmetric], auto)
apply (subst eln_mult_add, auto)
done
qed
lemma ennsqrt_square2 [simp]:
"ennsqrt (x * x) = x"
unfolding ennsqrt_mult by auto
lemma ennsqrt_eq_iff_square:
"ennsqrt x = y ⟷ x = y * y"
by auto
lemma ennsqrt_bij:
"bij ennsqrt"
by (rule bij_betw_byWitness[of _ "λx. x * x"], auto)
lemma ennsqrt_strict_mono:
"strict_mono ennsqrt"
unfolding ennsqrt_def
apply (rule strict_mono_compose[OF ennexp_strict_mono])
apply (rule strict_mono_compose[OF _ eln_strict_mono])
by (auto simp add: ereal_less_divide_pos ereal_mult_divide strict_mono_def)
lemma ennsqrt_mono:
"mono ennsqrt"
using ennsqrt_strict_mono by (simp add: strict_mono_mono)
lemma ennsqrt_mono2 [mono_intros]:
assumes "x ≤ y"
shows "ennsqrt x ≤ ennsqrt y"
using ennsqrt_mono assms unfolding mono_def by auto
lemma ennsqrt_continuous:
"continuous_on UNIV ennsqrt"
apply (rule continuous_onI_mono)
using ennsqrt_mono unfolding mono_def by (auto simp add: ennsqrt_bij bij_is_surj)
lemma ennsqrt_tendsto [tendsto_intros]:
assumes "((λn. u n) ⤏ l) F"
shows "((λn. ennsqrt(u n)) ⤏ ennsqrt l) F"
using ennsqrt_continuous assms by (metis UNIV_I continuous_on tendsto_compose)
lemma ennsqrt_ennreal_ennreal_sqrt [simp]:
assumes "t ≥ (0::real)"
shows "ennsqrt (ennreal t) = ennreal (sqrt t)"
proof -
have "ennreal t = ennreal (sqrt t) * ennreal(sqrt t)"
apply (subst ennreal_mult[symmetric]) using assms by auto
then show ?thesis
by auto
qed
lemma ennreal_sqrt2:
"ennreal (sqrt 2) = ennsqrt 2"
using ennsqrt_ennreal_ennreal_sqrt[of 2] by auto
lemma ennsqrt_4 [simp]:
"ennsqrt 4 = 2"
by (metis ennreal_numeral ennsqrt_ennreal_ennreal_sqrt real_sqrt_four zero_le_numeral)
lemma ennsqrt_le [simp]:
"ennsqrt x ≤ ennsqrt y ⟷ x ≤ y"
proof
assume "ennsqrt x ≤ ennsqrt y"
then have "ennsqrt x * ennsqrt x ≤ ennsqrt y * ennsqrt y"
by (intro mult_mono, auto)
then show "x ≤ y" by auto
qed (auto intro: mono_intros)
text ‹We can also define the square root on ereal using the square root on ennreal, and $0$
for negative numbers.›
definition esqrt::"ereal ⇒ ereal"
where "esqrt x = enn2ereal(ennsqrt (e2ennreal x))"
lemma esqrt_square [simp]:
assumes "x ≥ 0"
shows "(esqrt x) * (esqrt x) = x"
unfolding esqrt_def times_ennreal.rep_eq[symmetric] ennsqrt_square[of "e2ennreal x"]
using assms enn2ereal_e2ennreal by auto
lemma esqrt_of_neg [simp]:
assumes "x ≤ 0"
shows "esqrt x = 0"
unfolding esqrt_def e2ennreal_neg[OF assms] by (auto simp add: zero_ennreal.rep_eq)
lemma esqrt_nonneg [simp]:
"esqrt x ≥ 0"
unfolding esqrt_def by auto
lemma esqrt_eq_iff_square [simp]:
assumes "x ≥ 0" "y ≥ 0"
shows "esqrt x = y ⟷ x = y * y"
using esqrt_def esqrt_square assms apply auto
by (metis e2ennreal_enn2ereal ennsqrt_square2 eq_onp_same_args ereal_ennreal_cases leD times_ennreal.abs_eq)
lemma esqrt_simps [simp]:
"esqrt 0 = 0"
"esqrt 1 = 1"
"esqrt ∞ = ∞"
"esqrt top = top"
"esqrt (-∞) = 0"
by (auto simp: top_ereal_def)
lemma esqrt_mult:
assumes "a ≥ 0"
shows "esqrt(a * b) = esqrt a * esqrt b"
proof (cases "b ≥ 0")
case True
show ?thesis
unfolding esqrt_def apply (subst times_ennreal.rep_eq[symmetric])
apply (subst ennsqrt_mult[of "e2ennreal a" "e2ennreal b", symmetric])
apply (subst times_ennreal.abs_eq)
using assms True by (auto simp add: eq_onp_same_args)
next
case False
then have "a * b ≤ 0" using assms ereal_mult_le_0_iff by auto
then have "esqrt(a * b) = 0" by auto
moreover have "esqrt b = 0" using False by auto
ultimately show ?thesis by auto
qed
lemma esqrt_square2 [simp]:
"esqrt(x * x) = abs(x)"
proof -
have "esqrt(x * x) = esqrt(abs x * abs x)"
by (metis (no_types, hide_lams) abs_ereal_ge0 ereal_abs_mult ereal_zero_le_0_iff linear)
also have "... = abs x"
by (auto simp add: esqrt_mult)
finally show ?thesis by auto
qed
lemma esqrt_mono:
"mono esqrt"
unfolding esqrt_def mono_def by (auto intro: mono_intros)
lemma esqrt_mono2 [mono_intros]:
assumes "x ≤ y"
shows "esqrt x ≤ esqrt y"
using esqrt_mono assms unfolding mono_def by auto
lemma esqrt_continuous:
"continuous_on UNIV esqrt"
unfolding esqrt_def apply (rule continuous_on_compose2[of UNIV enn2ereal], intro continuous_on_enn2ereal)
by (rule continuous_on_compose2[of UNIV ennsqrt], auto intro!: ennsqrt_continuous continuous_on_e2ennreal)
lemma esqrt_tendsto [tendsto_intros]:
assumes "((λn. u n) ⤏ l) F"
shows "((λn. esqrt(u n)) ⤏ esqrt l) F"
using esqrt_continuous assms by (metis UNIV_I continuous_on tendsto_compose)
lemma esqrt_ereal_ereal_sqrt [simp]:
assumes "t ≥ (0::real)"
shows "esqrt (ereal t) = ereal (sqrt t)"
proof -
have "ereal t = ereal (sqrt t) * ereal(sqrt t)"
using assms by auto
then show ?thesis
using assms ereal_less_eq(5) esqrt_mult esqrt_square real_sqrt_ge_zero by presburger
qed
lemma ereal_sqrt2:
"ereal (sqrt 2) = esqrt 2"
using esqrt_ereal_ereal_sqrt[of 2] by auto
lemma esqrt_4 [simp]:
"esqrt 4 = 2"
by auto
lemma esqrt_le [simp]:
"esqrt x ≤ esqrt y ⟷ (x ≤ 0 ∨ x ≤ y)"
apply (auto simp add: esqrt_mono2)
by (metis eq_iff ereal_zero_times esqrt_mono2 esqrt_square le_cases)
text ‹Finally, we define eexp, as the composition of ennexp and the injection of ennreal in ereal.›
definition eexp::"ereal ⇒ ereal" where
"eexp x = enn2ereal (ennexp x)"
lemma eexp_special_values [simp]:
"eexp 0 = 1"
"eexp (∞) = ∞"
"eexp(-∞) = 0"
unfolding eexp_def by (auto simp add: zero_ennreal.rep_eq one_ennreal.rep_eq)
lemma eexp_strict_mono:
"strict_mono eexp"
unfolding eexp_def using ennexp_strict_mono unfolding strict_mono_def by (auto intro: mono_intros)
lemma eexp_mono:
"mono eexp"
using eexp_strict_mono by (simp add: strict_mono_mono)
lemma eexp_strict_mono2 [mono_intros]:
assumes "x < y"
shows "eexp x < eexp y"
using eexp_strict_mono assms unfolding strict_mono_def by auto
lemma eexp_mono2 [mono_intros]:
assumes "x ≤ y"
shows "eexp x ≤ eexp y"
using eexp_mono assms unfolding mono_def by auto
lemma eexp_le_eexp_iff_le:
"eexp x ≤ eexp y ⟷ x ≤ y"
using eexp_strict_mono2 not_le by (auto intro: mono_intros)
lemma eexp_lt_eexp_iff_lt:
"eexp x < eexp y ⟷ x < y"
using eexp_mono2 not_le by (auto intro: mono_intros)
lemma eexp_special_values_iff [simp]:
"eexp x = 0 ⟷ x = -∞"
"eexp x = 1 ⟷ x = 0"
"eexp x = ∞ ⟷ x = ∞"
"eexp x = top ⟷ x = ∞"
unfolding eexp_def apply (auto simp add: zero_ennreal.rep_eq one_ennreal.rep_eq top_ereal_def)
apply (metis e2ennreal_enn2ereal ennexp.simps(3) ennexp_strict_mono strict_mono_eq zero_ennreal_def)
by (metis e2ennreal_enn2ereal eln_ennexp eln_simps(2) one_ennreal_def)
lemma eexp_ineq_iff [simp]:
"eexp x ≤ 1 ⟷ x ≤ 0"
"eexp x ≥ 1 ⟷ x ≥ 0"
"eexp x > 1 ⟷ x > 0"
"eexp x < 1 ⟷ x < 0"
"eexp x ≥ 0"
"eexp x > 0 ⟷ x ≠ - ∞"
"eexp x < ∞ ⟷ x ≠ ∞"
apply (metis eexp_le_eexp_iff_le eexp_lt_eexp_iff_lt eexp_special_values)+
apply (simp add: eexp_def)
using eexp_strict_mono2 apply (force)
by simp
lemma eexp_ineq [mono_intros]:
"x ≤ 0 ⟹ eexp x ≤ 1"
"x < 0 ⟹ eexp x < 1"
"x ≥ 0 ⟹ eexp x ≥ 1"
"x > 0 ⟹ eexp x > 1"
"eexp x ≥ 0"
"x > -∞ ⟹ eexp x > 0"
"x < ∞ ⟹ eexp x < ∞"
by auto
lemma eexp_continuous:
"continuous_on UNIV eexp"
unfolding eexp_def by (rule continuous_on_compose2[of UNIV enn2ereal], auto simp: continuous_on_enn2ereal ennexp_continuous)
lemma eexp_tendsto' [simp]:
"((λn. eexp(u n)) ⤏ eexp l) F ⟷ ((λn. u n) ⤏ l) F"
proof
assume H: "((λn. eexp (u n)) ⤏ eexp l) F"
have "((λn. eln (e2ennreal (eexp (u n)))) ⤏ eln (e2ennreal (eexp l))) F"
by (intro tendsto_intros H)
then show "(u ⤏ l) F"
unfolding eexp_def by auto
next
assume "(u ⤏ l) F"
then show "((λn. eexp(u n)) ⤏ eexp l) F"
using eexp_continuous by (metis UNIV_I continuous_on tendsto_compose)
qed
lemma eexp_tendsto [tendsto_intros]:
assumes "((λn. u n) ⤏ l) F"
shows "((λn. eexp(u n)) ⤏ eexp l) F"
using assms by auto
lemma eexp_add_mult:
assumes "¬((a = ∞ ∧ b = -∞) ∨ (a = -∞ ∧ b = ∞))"
shows "eexp(a+b) = eexp a * eexp b"
using ennexp_add_mult[OF assms] unfolding eexp_def by (simp add: times_ennreal.rep_eq)
lemma eexp_ereal [simp]:
"eexp(ereal x) = ereal(exp x)"
by (simp add: eexp_def)
end
Theory Hausdorff_Distance
section ‹Hausdorff distance›
theory Hausdorff_Distance
imports Library_Complements
begin
subsection ‹Preliminaries›
subsection ‹Hausdorff distance›
text ‹The Hausdorff distance between two subsets of a metric space is the minimal $M$ such that
each set is included in the $M$-neighborhood of the other. For nonempty bounded sets, it
satisfies the triangular inequality, it is symmetric, but it vanishes on sets that have the same
closure. In particular, it defines a distance on closed bounded nonempty sets. We establish
all these properties below.›
definition hausdorff_distance::"('a::metric_space) set ⇒ 'a set ⇒ real"
where "hausdorff_distance A B = (if A = {} ∨ B = {} ∨ (¬(bounded A)) ∨ (¬(bounded B)) then 0
else max (SUP x∈A. infdist x B) (SUP x∈B. infdist x A))"
lemma hausdorff_distance_self [simp]:
"hausdorff_distance A A = 0"
unfolding hausdorff_distance_def by auto
lemma hausdorff_distance_sym:
"hausdorff_distance A B = hausdorff_distance B A"
unfolding hausdorff_distance_def by auto
lemma hausdorff_distance_points [simp]:
"hausdorff_distance {x} {y} = dist x y"
unfolding hausdorff_distance_def by (auto, metis dist_commute max.idem)
text ‹The Hausdorff distance is expressed in terms of a supremum. To use it, one needs again
and again to show that this is the supremum of a set which is bounded from above.›
lemma bdd_above_infdist_aux:
assumes "bounded A" "bounded B"
shows "bdd_above ((λx. infdist x B)`A)"
proof (cases "B = {}")
case True
then show ?thesis unfolding infdist_def by auto
next
case False
then obtain y where "y ∈ B" by auto
then have "infdist x B ≤ dist x y" if "x ∈ A" for x
by (simp add: infdist_le)
then show ?thesis unfolding bdd_above_def
by (auto, metis assms(1) bounded_any_center dist_commute order_trans)
qed
lemma hausdorff_distance_nonneg [simp, mono_intros]:
"hausdorff_distance A B ≥ 0"
proof (cases "A = {} ∨ B = {} ∨ (¬(bounded A)) ∨ (¬(bounded B))")
case True
then show ?thesis unfolding hausdorff_distance_def by auto
next
case False
then have "A ≠ {}" "B ≠ {}" "bounded A" "bounded B" by auto
have "(SUP x∈A. infdist x B) ≥ 0"
using bdd_above_infdist_aux[OF ‹bounded A› ‹bounded B›] infdist_nonneg
by (metis ‹A ≠ {}› all_not_in_conv cSUP_upper2)
moreover have "(SUP x∈B. infdist x A) ≥ 0"
using bdd_above_infdist_aux[OF ‹bounded B› ‹bounded A›] infdist_nonneg
by (metis ‹B ≠ {}› all_not_in_conv cSUP_upper2)
ultimately show ?thesis unfolding hausdorff_distance_def by auto
qed
lemma hausdorff_distanceI:
assumes "⋀x. x ∈ A ⟹ infdist x B ≤ D"
"⋀x. x ∈ B ⟹ infdist x A ≤ D"
"D ≥ 0"
shows "hausdorff_distance A B ≤ D"
proof (cases "A = {} ∨ B = {} ∨ (¬(bounded A)) ∨ (¬(bounded B))")
case True
then show ?thesis unfolding hausdorff_distance_def using ‹D ≥ 0› by auto
next
case False
then have "A ≠ {}" "B ≠ {}" "bounded A" "bounded B" by auto
have "(SUP x∈A. infdist x B) ≤ D"
apply (rule cSUP_least, simp add: ‹A ≠ {}›) using assms(1) by blast
moreover have "(SUP x∈B. infdist x A) ≤ D"
apply (rule cSUP_least, simp add: ‹B ≠ {}›) using assms(2) by blast
ultimately show ?thesis unfolding hausdorff_distance_def using False by auto
qed
lemma hausdorff_distanceI2:
assumes "⋀x. x ∈ A ⟹ ∃y∈B. dist x y ≤ D"
"⋀x. x ∈ B ⟹ ∃y∈A. dist x y ≤ D"
"D ≥ 0"
shows "hausdorff_distance A B ≤ D"
proof (rule hausdorff_distanceI[OF _ _ ‹D ≥ 0›])
fix x assume "x ∈ A" show "infdist x B ≤ D" using assms(1)[OF ‹x ∈ A›] infdist_le2 by fastforce
next
fix x assume "x ∈ B" show "infdist x A ≤ D" using assms(2)[OF ‹x ∈ B›] infdist_le2 by fastforce
qed
lemma infdist_le_hausdorff_distance [mono_intros]:
assumes "x ∈ A" "bounded A" "bounded B"
shows "infdist x B ≤ hausdorff_distance A B"
proof (cases "B = {}")
case True
then have "infdist x B = 0" unfolding infdist_def by auto
then show ?thesis using hausdorff_distance_nonneg by auto
next
case False
have "infdist x B ≤ (SUP y∈A. infdist y B)"
using bdd_above_infdist_aux[OF ‹bounded A› ‹bounded B›] by (meson assms(1) cSUP_upper)
then show ?thesis unfolding hausdorff_distance_def using assms False by auto
qed
lemma hausdorff_distance_infdist_triangle [mono_intros]:
assumes "B ≠ {}" "bounded B" "bounded C"
shows "infdist x C ≤ infdist x B + hausdorff_distance B C"
proof (cases "C = {}")
case True
then have "infdist x C = 0" unfolding infdist_def by auto
then show ?thesis using infdist_nonneg[of x B] hausdorff_distance_nonneg[of B C] by auto
next
case False
have "infdist x C - hausdorff_distance B C ≤ dist x b" if "b ∈ B" for b
proof -
have "infdist x C ≤ infdist b C + dist x b" by (rule infdist_triangle)
also have "... ≤ dist x b + hausdorff_distance B C"
using infdist_le_hausdorff_distance[OF ‹b ∈ B› ‹bounded B› ‹bounded C›] by auto
finally show ?thesis by auto
qed
then have "infdist x C - hausdorff_distance B C ≤ infdist x B"
unfolding infdist_def using ‹B ≠ {}› by (simp add: le_cINF_iff)
then show ?thesis by auto
qed
lemma hausdorff_distance_triangle [mono_intros]:
assumes "B ≠ {}" "bounded B"
shows "hausdorff_distance A C ≤ hausdorff_distance A B + hausdorff_distance B C"
proof (cases "A = {} ∨ C = {} ∨ (¬(bounded A)) ∨ (¬(bounded C))")
case True
then have "hausdorff_distance A C = 0" unfolding hausdorff_distance_def by auto
then show ?thesis
using hausdorff_distance_nonneg[of A B] hausdorff_distance_nonneg[of B C] by auto
next
case False
then have *: "A ≠ {}" "C ≠ {}" "bounded A" "bounded C" by auto
define M where "M = hausdorff_distance A B + hausdorff_distance B C"
have "infdist x C ≤ M" if "x ∈ A" for x
using hausdorff_distance_infdist_triangle[OF ‹B ≠ {}› ‹bounded B › ‹bounded C›, of x]
infdist_le_hausdorff_distance[OF ‹x ∈ A› ‹bounded A› ‹bounded B›] by (auto simp add: M_def)
moreover have "infdist x A ≤ M" if "x ∈ C" for x
using hausdorff_distance_infdist_triangle[OF ‹B ≠ {}› ‹bounded B › ‹bounded A›, of x]
infdist_le_hausdorff_distance[OF ‹x ∈ C› ‹bounded C› ‹bounded B›]
by (auto simp add: hausdorff_distance_sym M_def)
ultimately have "hausdorff_distance A C ≤ M"
unfolding hausdorff_distance_def using * bdd_above_infdist_aux by (auto simp add: cSUP_least)
then show ?thesis unfolding M_def by auto
qed
lemma hausdorff_distance_subset:
assumes "A ⊆ B" "A ≠ {}" "bounded B"
shows "hausdorff_distance A B = (SUP x∈B. infdist x A)"
proof -
have H: "B ≠ {}" "bounded A" using assms bounded_subset by auto
have "(SUP x∈A. infdist x B) = 0" using assms by (simp add: subset_eq)
moreover have "(SUP x∈B. infdist x A) ≥ 0"
using bdd_above_infdist_aux[OF ‹bounded B› ‹bounded A›] infdist_nonneg[of _ A]
by (meson H(1) cSUP_upper2 ex_in_conv)
ultimately show ?thesis unfolding hausdorff_distance_def using assms H by auto
qed
lemma hausdorff_distance_closure [simp]:
"hausdorff_distance A (closure A) = 0"
proof (cases "A = {} ∨ (¬(bounded A))")
case True
then show ?thesis unfolding hausdorff_distance_def by auto
next
case False
then have "A ≠ {}" "bounded A" by auto
then have "closure A ≠ {}" "bounded (closure A)" "A ⊆ closure A"
using closure_subset by auto
have "infdist x A = 0" if "x ∈ closure A" for x
using in_closure_iff_infdist_zero[OF ‹A ≠ {}›] that by auto
then have "(SUP x∈closure A. infdist x A) = 0"
using ‹closure A ≠ {}› by auto
then show ?thesis
unfolding hausdorff_distance_subset[OF ‹A ⊆ closure A› ‹A ≠ {}› ‹bounded (closure A)›] by simp
qed
lemma hausdorff_distance_closures [simp]:
"hausdorff_distance (closure A) (closure B) = hausdorff_distance A B"
proof (cases "A = {} ∨ B = {} ∨ (¬(bounded A)) ∨ (¬(bounded B))")
case True
then have *: "hausdorff_distance A B = 0" unfolding hausdorff_distance_def by auto
have "closure A = {} ∨ (¬(bounded (closure A))) ∨ closure B = {} ∨ (¬(bounded (closure B)))"
using True bounded_subset closure_subset by auto
then have "hausdorff_distance (closure A) (closure B) = 0"
unfolding hausdorff_distance_def by auto
then show ?thesis using * by simp
next
case False
then have H: "A ≠ {}" "B ≠ {}" "bounded A" "bounded B" by auto
then have H2: "closure A ≠ {}" "closure B ≠ {}" "bounded (closure A)" "bounded (closure B)"
by auto
have "hausdorff_distance A B ≤ hausdorff_distance A (closure A) + hausdorff_distance (closure A) B"
apply (rule hausdorff_distance_triangle) using H H2 by auto
also have "... = hausdorff_distance (closure A) B"
using hausdorff_distance_closure by auto
also have "... ≤ hausdorff_distance (closure A) (closure B) + hausdorff_distance (closure B) B"
apply (rule hausdorff_distance_triangle) using H H2 by auto
also have "... = hausdorff_distance (closure A) (closure B)"
using hausdorff_distance_closure by (auto simp add: hausdorff_distance_sym)
finally have *: "hausdorff_distance A B ≤ hausdorff_distance (closure A) (closure B)" by simp
have "hausdorff_distance (closure A) (closure B) ≤ hausdorff_distance (closure A) A + hausdorff_distance A (closure B)"
apply (rule hausdorff_distance_triangle) using H H2 by auto
also have "... = hausdorff_distance A (closure B)"
using hausdorff_distance_closure by (auto simp add: hausdorff_distance_sym)
also have "... ≤ hausdorff_distance A B + hausdorff_distance B (closure B)"
apply (rule hausdorff_distance_triangle) using H H2 by auto
also have "... = hausdorff_distance A B"
using hausdorff_distance_closure by (auto simp add: hausdorff_distance_sym)
finally have "hausdorff_distance (closure A) (closure B) ≤ hausdorff_distance A B" by simp
then show ?thesis using * by auto
qed
lemma hausdorff_distance_zero:
assumes "A ≠ {}" "bounded A" "B ≠ {}" "bounded B"
shows "hausdorff_distance A B = 0 ⟷ closure A = closure B"
proof
assume H: "hausdorff_distance A B = 0"
have "A ⊆ closure B"
proof
fix x assume "x ∈ A"
have "infdist x B = 0"
using infdist_le_hausdorff_distance[OF ‹x ∈ A› ‹bounded A› ‹bounded B›] H infdist_nonneg[of x B] by auto
then show "x ∈ closure B" using in_closure_iff_infdist_zero[OF ‹B ≠ {}›] by auto
qed
then have A: "closure A ⊆ closure B" by (simp add: closure_minimal)
have "B ⊆ closure A"
proof
fix x assume "x ∈ B"
have "infdist x A = 0"
using infdist_le_hausdorff_distance[OF ‹x ∈ B› ‹bounded B› ‹bounded A›] H infdist_nonneg[of x A]
by (auto simp add: hausdorff_distance_sym)
then show "x ∈ closure A" using in_closure_iff_infdist_zero[OF ‹A ≠ {}›] by auto
qed
then have "closure B ⊆ closure A" by (simp add: closure_minimal)
then show "closure A = closure B" using A by auto
next
assume "closure A = closure B"
then show "hausdorff_distance A B = 0"
using hausdorff_distance_closures[of A B] by auto
qed
lemma hausdorff_distance_vimage:
assumes "⋀x. x ∈ A ⟹ dist (f x) (g x) ≤ C"
"C ≥ 0"
shows "hausdorff_distance (f`A) (g`A) ≤ C"
apply (rule hausdorff_distanceI2[OF _ _ ‹C ≥ 0›]) using assms by (auto simp add: dist_commute, auto)
lemma hausdorff_distance_union [mono_intros]:
assumes "A ≠ {}" "B ≠ {}" "C ≠ {}" "D ≠ {}"
shows "hausdorff_distance (A ∪ B) (C ∪ D) ≤ max (hausdorff_distance A C) (hausdorff_distance B D)"
proof (cases "bounded A ∧ bounded B ∧ bounded C ∧ bounded D")
case False
then have "hausdorff_distance (A ∪ B) (C ∪ D) = 0"
unfolding hausdorff_distance_def by auto
then show ?thesis
by (simp add: hausdorff_distance_nonneg le_max_iff_disj)
next
case True
show ?thesis
proof (rule hausdorff_distanceI, auto)
fix x assume H: "x ∈ A"
have "infdist x (C ∪ D) ≤ infdist x C"
by (simp add: assms infdist_union_min)
also have "... ≤ hausdorff_distance A C"
apply (rule infdist_le_hausdorff_distance) using H True by auto
also have "... ≤ max (hausdorff_distance A C) (hausdorff_distance B D)"
by auto
finally show "infdist x (C ∪ D) ≤ max (hausdorff_distance A C) (hausdorff_distance B D)"
by simp
next
fix x assume H: "x ∈ B"
have "infdist x (C ∪ D) ≤ infdist x D"
by (simp add: assms infdist_union_min)
also have "... ≤ hausdorff_distance B D"
apply (rule infdist_le_hausdorff_distance) using H True by auto
also have "... ≤ max (hausdorff_distance A C) (hausdorff_distance B D)"
by auto
finally show "infdist x (C ∪ D) ≤ max (hausdorff_distance A C) (hausdorff_distance B D)"
by simp
next
fix x assume H: "x ∈ C"
have "infdist x (A ∪ B) ≤ infdist x A"
by (simp add: assms infdist_union_min)
also have "... ≤ hausdorff_distance C A"
apply (rule infdist_le_hausdorff_distance) using H True by auto
also have "... ≤ max (hausdorff_distance A C) (hausdorff_distance B D)"
using hausdorff_distance_sym[of A C] by auto
finally show "infdist x (A ∪ B) ≤ max (hausdorff_distance A C) (hausdorff_distance B D)"
by simp
next
fix x assume H: "x ∈ D"
have "infdist x (A ∪ B) ≤ infdist x B"
by (simp add: assms infdist_union_min)
also have "... ≤ hausdorff_distance D B"
apply (rule infdist_le_hausdorff_distance) using H True by auto
also have "... ≤ max (hausdorff_distance A C) (hausdorff_distance B D)"
using hausdorff_distance_sym[of B D] by auto
finally show "infdist x (A ∪ B) ≤ max (hausdorff_distance A C) (hausdorff_distance B D)"
by simp
qed (simp add: le_max_iff_disj)
qed
end
Theory Isometries
section ‹Isometries›
theory Isometries
imports Library_Complements Hausdorff_Distance
begin
text ‹Isometries, i.e., functions that preserve distances, show up very often in mathematics.
We introduce a dedicated definition, and show its basic properties.›
definition isometry_on::"('a::metric_space) set ⇒ ('a ⇒ ('b::metric_space)) ⇒ bool"
where "isometry_on X f = (∀x ∈ X. ∀y ∈ X. dist (f x) (f y) = dist x y)"
definition isometry :: "('a::metric_space ⇒ 'b::metric_space) ⇒ bool"
where "isometry f ≡ isometry_on UNIV f ∧ range f = UNIV"
lemma isometry_on_subset:
assumes "isometry_on X f"
"Y ⊆ X"
shows "isometry_on Y f"
using assms unfolding isometry_on_def by auto
lemma isometry_onI [intro?]:
assumes "⋀x y. x ∈ X ⟹ y ∈ X ⟹ dist (f x) (f y) = dist x y"
shows "isometry_on X f"
using assms unfolding isometry_on_def by auto
lemma isometry_onD:
assumes "isometry_on X f"
"x ∈ X" "y ∈ X"
shows "dist (f x) (f y) = dist x y"
using assms unfolding isometry_on_def by auto
lemma isometryI [intro?]:
assumes "⋀x y. dist (f x) (f y) = dist x y"
"range f = UNIV"
shows "isometry f"
unfolding isometry_def isometry_on_def using assms by auto
lemma
assumes "isometry_on X f"
shows isometry_on_lipschitz: "1-lipschitz_on X f"
and isometry_on_uniformly_continuous: "uniformly_continuous_on X f"
and isometry_on_continuous: "continuous_on X f"
proof -
show "1-lipschitz_on X f" apply (rule lipschitz_onI) using isometry_onD[OF assms] by auto
then show "uniformly_continuous_on X f" "continuous_on X f"
using lipschitz_on_uniformly_continuous lipschitz_on_continuous_on by auto
qed
lemma isometryD:
assumes "isometry f"
shows "isometry_on UNIV f"
"dist (f x) (f y) = dist x y"
"range f = UNIV"
"1-lipschitz_on UNIV f"
"uniformly_continuous_on UNIV f"
"continuous_on UNIV f"
using assms unfolding isometry_def isometry_on_def apply auto
using isometry_on_lipschitz isometry_on_uniformly_continuous isometry_on_continuous assms unfolding isometry_def by blast+
lemma isometry_on_injective:
assumes "isometry_on X f"
shows "inj_on f X"
using assms inj_on_def isometry_on_def by force
lemma isometry_on_compose:
assumes "isometry_on X f"
"isometry_on (f`X) g"
shows "isometry_on X (λx. g(f x))"
using assms unfolding isometry_on_def by auto
lemma isometry_on_cong:
assumes "isometry_on X f"
"⋀x. x ∈ X ⟹ g x = f x"
shows "isometry_on X g"
using assms unfolding isometry_on_def by auto
lemma isometry_on_inverse:
assumes "isometry_on X f"
shows "isometry_on (f`X) (inv_into X f)"
"⋀x. x ∈ X ⟹ (inv_into X f) (f x) = x"
"⋀y. y ∈ f`X ⟹ f (inv_into X f y) = y"
"bij_betw f X (f`X)"
proof -
show *: "bij_betw f X (f`X)"
using assms unfolding bij_betw_def inj_on_def isometry_on_def by force
show "isometry_on (f`X) (inv_into X f)"
using assms unfolding isometry_on_def
by (auto) (metis (mono_tags, lifting) dist_eq_0_iff inj_on_def inv_into_f_f)
fix x assume "x ∈ X"
then show "(inv_into X f) (f x) = x"
using * by (simp add: bij_betw_def)
next
fix y assume "y ∈ f`X"
then show "f (inv_into X f y) = y"
by (simp add: f_inv_into_f)
qed
lemma isometry_inverse:
assumes "isometry f"
shows "isometry (inv f)"
"bij f"
using isometry_on_inverse[OF isometryD(1)[OF assms]] isometryD(3)[OF assms]
unfolding isometry_def by (auto simp add: bij_imp_bij_inv bij_is_surj)
lemma isometry_on_homeomorphism:
assumes "isometry_on X f"
shows "homeomorphism X (f`X) f (inv_into X f)"
"homeomorphism_on X f"
"X homeomorphic f`X"
proof -
show *: "homeomorphism X (f`X) f (inv_into X f)"
apply (rule homeomorphismI) using uniformly_continuous_imp_continuous[OF isometry_on_uniformly_continuous]
isometry_on_inverse[OF assms] assms by auto
then show "X homeomorphic f`X"
unfolding homeomorphic_def by auto
show "homeomorphism_on X f"
unfolding homeomorphism_on_def using * by auto
qed
lemma isometry_homeomorphism:
fixes f::"('a::metric_space) ⇒ ('b::metric_space)"
assumes "isometry f"
shows "homeomorphism UNIV UNIV f (inv f)"
"(UNIV::'a set) homeomorphic (UNIV::'b set)"
using isometry_on_homeomorphism[OF isometryD(1)[OF assms]] isometryD(3)[OF assms] by auto
lemma isometry_on_closure:
assumes "isometry_on X f"
"continuous_on (closure X) f"
shows "isometry_on (closure X) f"
proof (rule isometry_onI)
fix x y assume "x ∈ closure X" "y ∈ closure X"
obtain u v::"nat ⇒ 'a" where *: "⋀n. u n ∈ X" "u ⇢ x"
"⋀n. v n ∈ X" "v ⇢ y"
using ‹x ∈ closure X› ‹y ∈ closure X› unfolding closure_sequential by blast
have "(λn. f (u n)) ⇢ f x"
using *(1) *(2) ‹x ∈ closure X› ‹continuous_on (closure X) f›
unfolding comp_def continuous_on_closure_sequentially[of X f] by auto
moreover have "(λn. f (v n)) ⇢ f y"
using *(3) *(4) ‹y ∈ closure X› ‹continuous_on (closure X) f›
unfolding comp_def continuous_on_closure_sequentially[of X f] by auto
ultimately have "(λn. dist (f (u n)) (f (v n))) ⇢ dist (f x) (f y)"
by (simp add: tendsto_dist)
then have "(λn. dist (u n) (v n)) ⇢ dist (f x) (f y)"
using assms(1) *(1) *(3) unfolding isometry_on_def by auto
moreover have "(λn. dist (u n) (v n)) ⇢ dist x y"
using *(2) *(4) by (simp add: tendsto_dist)
ultimately show "dist (f x) (f y) = dist x y" using LIMSEQ_unique by auto
qed
lemma isometry_extend_closure:
fixes f::"('a::metric_space) ⇒ ('b::complete_space)"
assumes "isometry_on X f"
shows "∃g. isometry_on (closure X) g ∧ (∀x∈X. g x = f x)"
proof -
obtain g where g: "⋀x. x ∈ X ⟹ g x = f x" "uniformly_continuous_on (closure X) g"
using uniformly_continuous_on_extension_on_closure[OF isometry_on_uniformly_continuous[OF assms]] by metis
have "isometry_on (closure X) g"
apply (rule isometry_on_closure, rule isometry_on_cong[OF assms])
using g uniformly_continuous_imp_continuous[OF g(2)] by auto
then show ?thesis using g(1) by auto
qed
lemma isometry_on_complete_image:
assumes "isometry_on X f"
"complete X"
shows "complete (f`X)"
proof (rule completeI)
fix u :: "nat ⇒ 'b" assume u: "∀n. u n ∈ f`X" "Cauchy u"
define v where "v = (λn. inv_into X f (u n))"
have "v n ∈ X" for n
unfolding v_def by (simp add: inv_into_into u(1))
have "dist (v n) (v m) = dist (u n) (u m)" for m n
using u(1) isometry_on_inverse[OF ‹isometry_on X f›] unfolding isometry_on_def v_def by (auto simp add: inv_into_into)
then have "Cauchy v"
using u(2) unfolding Cauchy_def by auto
obtain l where "l ∈ X" "v ⇢ l"
apply (rule completeE[OF ‹complete X› _ ‹Cauchy v›]) using ‹⋀n. v n ∈ X› by auto
have "(λn. f (v n)) ⇢ f l"
apply (rule continuous_on_tendsto_compose[OF isometry_on_continuous[OF ‹isometry_on X f›]])
using ‹⋀n. v n ∈ X› ‹l ∈ X› ‹v ⇢ l› by auto
moreover have "f(v n) = u n" for n
unfolding v_def by (simp add: f_inv_into_f u(1))
ultimately have "u ⇢ f l" by auto
then show "∃m ∈ f`X. u ⇢ m" using ‹l ∈ X› by auto
qed
lemma isometry_on_id [simp]:
"isometry_on A (λx. x)"
"isometry_on A id"
unfolding isometry_on_def by auto
lemma isometry_on_add [simp]:
"isometry_on A (λx. x + (t::'a::real_normed_vector))"
unfolding isometry_on_def by auto
lemma isometry_on_minus [simp]:
"isometry_on A (λ(x::'a::real_normed_vector). -x)"
unfolding isometry_on_def by (auto simp add: dist_minus)
lemma isometry_on_diff [simp]:
"isometry_on A (λx. (t::'a::real_normed_vector) - x)"
unfolding isometry_on_def by (auto, metis add_uminus_conv_diff dist_add_cancel dist_minus)
lemma isometry_preserves_bounded:
assumes "isometry_on X f"
"A ⊆ X"
shows "bounded (f`A) ⟷ bounded A"
unfolding bounded_two_points using assms(2) isometry_onD[OF assms(1)] by auto (metis assms(2) rev_subsetD)+
lemma isometry_preserves_infdist:
"infdist (f x) (f`A) = infdist x A"
if "isometry_on X f" "A ⊆ X" "x ∈ X"
using that by (simp add: infdist_def image_comp isometry_on_def subset_iff)
lemma isometry_preserves_hausdorff_distance:
"hausdorff_distance (f`A) (f`B) = hausdorff_distance A B"
if "isometry_on X f" "A ⊆ X" "B ⊆ X"
using that isometry_preserves_infdist [OF that(1) that(2)]
isometry_preserves_infdist [OF that(1) that(3)]
isometry_preserves_bounded [OF that(1) that(2)]
isometry_preserves_bounded [OF that(1) that(3)]
by (simp add: hausdorff_distance_def image_comp subset_eq)
lemma isometry_on_UNIV_iterates:
fixes f::"('a::metric_space) ⇒ 'a"
assumes "isometry_on UNIV f"
shows "isometry_on UNIV (f^^n)"
by (induction n, auto, rule isometry_on_compose[of _ _ f], auto intro: isometry_on_subset[OF assms])
lemma isometry_iterates:
fixes f::"('a::metric_space) ⇒ 'a"
assumes "isometry f"
shows "isometry (f^^n)"
using isometry_on_UNIV_iterates[OF isometryD(1)[OF assms], of n] bij_fn[OF isometry_inverse(2)[OF assms], of n]
unfolding isometry_def by (simp add: bij_is_surj)
section ‹Geodesic spaces›
text ‹A geodesic space is a metric space in which any pair of points can be joined by a geodesic segment,
i.e., an isometrically embedded copy of a segment in the real line. Most spaces in geometry are
geodesic. We introduce in this section the corresponding class of metric spaces. First, we study
properties of general geodesic segments in metric spaces.›
subsection ‹Geodesic segments in general metric spaces›
definition geodesic_segment_between::"('a::metric_space) set ⇒ 'a ⇒ 'a ⇒ bool"
where "geodesic_segment_between G x y = (∃g::(real ⇒ 'a). g 0 = x ∧ g (dist x y) = y ∧ isometry_on {0..dist x y} g ∧ G = g`{0..dist x y})"
definition geodesic_segment::"('a::metric_space) set ⇒ bool"
where "geodesic_segment G = (∃x y. geodesic_segment_between G x y)"
text ‹We also introduce the parametrization of a geodesic segment. It is convenient to use the
following definition, which guarantees that the point is on $G$ even without checking that $G$
is a geodesic segment or that the parameter is in the reasonable range: this shortens some
arguments below.›
definition geodesic_segment_param::"('a::metric_space) set ⇒ 'a ⇒ real ⇒ 'a"
where "geodesic_segment_param G x t = (if ∃w. w ∈ G ∧ dist x w = t then SOME w. w ∈ G ∧ dist x w = t else SOME w. w ∈ G)"
lemma geodesic_segment_betweenI:
assumes "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
shows "geodesic_segment_between G x y"
unfolding geodesic_segment_between_def apply (rule exI[of _ g]) using assms by auto
lemma geodesic_segmentI [intro, simp]:
assumes "geodesic_segment_between G x y"
shows "geodesic_segment G"
unfolding geodesic_segment_def using assms by auto
lemma geodesic_segmentI2 [intro]:
assumes "isometry_on {a..b} g" "a ≤ (b::real)"
shows "geodesic_segment_between (g`{a..b}) (g a) (g b)"
"geodesic_segment (g`{a..b})"
proof -
define h where "h = (λt. g (t+a))"
have *: "isometry_on {0..b-a} h"
apply (rule isometry_onI)
using ‹isometry_on {a..b} g› ‹a ≤ b› by (auto simp add: isometry_on_def h_def)
have **: "dist (h 0) (h (b-a)) = b-a"
using isometry_onD[OF ‹isometry_on {0..b-a} h›, of 0 "b-a"] ‹a ≤ b› unfolding dist_real_def by auto
have "geodesic_segment_between (h`{0..b-a}) (h 0) (h (b-a))"
unfolding geodesic_segment_between_def apply (rule exI[of _ h]) unfolding ** using * by auto
moreover have "g`{a..b} = h`{0..b-a}"
unfolding h_def apply (auto simp add: image_iff)
by (metis add.commute atLeastAtMost_iff diff_ge_0_iff_ge diff_right_mono le_add_diff_inverse)
moreover have "h 0 = g a" "h (b-a) = g b" unfolding h_def by auto
ultimately show "geodesic_segment_between (g`{a..b}) (g a) (g b)" by auto
then show "geodesic_segment (g`{a..b})" unfolding geodesic_segment_def by auto
qed
lemma geodesic_segmentD:
assumes "geodesic_segment_between G x y"
shows "∃g::(real ⇒ _). (g t = x ∧ g (t + dist x y) = y ∧ isometry_on {t..t+dist x y} g ∧ G = g`{t..t+dist x y})"
proof -
obtain h where h: "h 0 = x" "h (dist x y) = y" "isometry_on {0..dist x y} h" "G = h`{0..dist x y}"
by (meson ‹geodesic_segment_between G x y› geodesic_segment_between_def)
have * [simp]: "(λx. x - t) ` {t..t + dist x y} = {0..dist x y}" by auto
define g where "g = (λs. h (s - t))"
have "g t = x" "g (t + dist x y) = y" using h assms(1) unfolding g_def by auto
moreover have "isometry_on {t..t+dist x y} g"
unfolding g_def apply (rule isometry_on_compose[of _ _ h])
by (simp add: dist_real_def isometry_on_def, simp add: h(3))
moreover have "g` {t..t + dist x y} = G" unfolding g_def h(4) using * by (metis image_image)
ultimately show ?thesis by auto
qed
lemma geodesic_segment_endpoints [simp]:
assumes "geodesic_segment_between G x y"
shows "x ∈ G" "y ∈ G" "G ≠ {}"
using assms unfolding geodesic_segment_between_def
by (auto, metis atLeastAtMost_iff image_eqI less_eq_real_def zero_le_dist)
lemma geodesic_segment_commute:
assumes "geodesic_segment_between G x y"
shows "geodesic_segment_between G y x"
proof -
obtain g::"real⇒'a" where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
by (meson ‹geodesic_segment_between G x y› geodesic_segment_between_def)
define h::"real⇒'a" where "h = (λt. g(dist x y-t))"
have "(λt. dist x y -t)`{0..dist x y} = {0..dist x y}" by auto
then have "h`{0..dist x y} = G" unfolding g(4) h_def by (metis image_image)
moreover have "h 0 = y" "h (dist x y) = x" unfolding h_def using g by auto
moreover have "isometry_on {0..dist x y} h"
unfolding h_def apply (rule isometry_on_compose[of _ _ g]) using g(3) by auto
ultimately show ?thesis
unfolding geodesic_segment_between_def by (auto simp add: dist_commute)
qed
lemma geodesic_segment_dist:
assumes "geodesic_segment_between G x y" "a ∈ G"
shows "dist x a + dist a y = dist x y"
proof -
obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
by (meson ‹geodesic_segment_between G x y› geodesic_segment_between_def)
obtain t where t: "t ∈ {0..dist x y}" "a = g t"
using g(4) assms by auto
have "dist x a = t" using isometry_onD[OF g(3) _ t(1), of 0]
unfolding g(1) dist_real_def t(2) using t(1) by auto
moreover have "dist a y = dist x y - t" using isometry_onD[OF g(3) _ t(1), of "dist x y"]
unfolding g(2) dist_real_def t(2) using t(1) by (auto simp add: dist_commute)
ultimately show ?thesis by auto
qed
lemma geodesic_segment_dist_unique:
assumes "geodesic_segment_between G x y" "a ∈ G" "b ∈ G" "dist x a = dist x b"
shows "a = b"
proof -
obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
by (meson ‹geodesic_segment_between G x y› geodesic_segment_between_def)
obtain ta where ta: "ta ∈ {0..dist x y}" "a = g ta"
using g(4) assms by auto
have *: "dist x a = ta"
unfolding g(1)[symmetric] ta(2) using isometry_onD[OF g(3), of 0 ta]
unfolding dist_real_def using ta(1) by auto
obtain tb where tb: "tb ∈ {0..dist x y}" "b = g tb"
using g(4) assms by auto
have "dist x b = tb"
unfolding g(1)[symmetric] tb(2) using isometry_onD[OF g(3), of 0 tb]
unfolding dist_real_def using tb(1) by auto
then have "ta = tb" using * ‹dist x a = dist x b› by auto
then show "a = b" using ta(2) tb(2) by auto
qed
lemma geodesic_segment_union:
assumes "dist x z = dist x y + dist y z"
"geodesic_segment_between G x y" "geodesic_segment_between H y z"
shows "geodesic_segment_between (G ∪ H) x z"
"G ∩ H = {y}"
proof -
obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
by (meson ‹geodesic_segment_between G x y› geodesic_segment_between_def)
obtain h where h: "h (dist x y) = y" "h (dist x z) = z" "isometry_on {dist x y..dist x z} h" "H = h`{dist x y..dist x z}"
unfolding ‹dist x z = dist x y + dist y z›
using geodesic_segmentD[OF ‹geodesic_segment_between H y z›, of "dist x y"] by auto
define f where "f = (λt. if t ≤ dist x y then g t else h t)"
have fg: "f t = g t" if "t ≤ dist x y" for t
unfolding f_def using that by auto
have fh: "f t = h t" if "t ≥ dist x y" for t
unfolding f_def apply (cases "t > dist x y") using that g(2) h(1) by auto
have "f 0 = x" "f (dist x z) = z" using fg fh g(1) h(2) assms(1) by auto
have "f`{0..dist x z} = f`{0..dist x y} ∪ f`{dist x y..dist x z}"
unfolding assms(1) image_Un[symmetric] by (simp add: ivl_disj_un_two_touch(4))
moreover have "f`{0..dist x y} = G"
unfolding g(4) using fg image_cong by force
moreover have "f`{dist x y..dist x z} = H"
unfolding h(4) using fh image_cong by force
ultimately have "f`{0..dist x z} = G ∪ H" by simp
have Ifg: "dist (f s) (f t) = s-t" if "0 ≤ t" "t ≤ s" "s ≤ dist x y" for s t
using that fg[of s] fg[of t] isometry_onD[OF g(3), of s t] unfolding dist_real_def by auto
have Ifh: "dist (f s) (f t) = s-t" if "dist x y ≤ t" "t ≤ s" "s ≤ dist x z" for s t
using that fh[of s] fh[of t] isometry_onD[OF h(3), of s t] unfolding dist_real_def by auto
have I: "dist (f s) (f t) = s-t" if "0 ≤ t" "t ≤ s" "s ≤ dist x z" for s t
proof -
consider "t ≤ dist x y ∧ s ≥ dist x y" | "s ≤ dist x y" | "t ≥ dist x y" by fastforce
then show ?thesis
proof (cases)
case 1
have "dist (f t) (f s) ≤ dist (f t) (f (dist x y)) + dist (f (dist x y)) (f s)"
using dist_triangle by auto
also have "... ≤ (dist x y - t) + (s - dist x y)"
using that 1 Ifg[of t "dist x y"] Ifh[of "dist x y" s] by (auto simp add: dist_commute intro: mono_intros)
finally have *: "dist (f t) (f s) ≤ s - t" by simp
have "dist x z ≤ dist (f 0) (f t) + dist (f t) (f s) + dist (f s) (f (dist x z))"
unfolding ‹f 0 = x› ‹f (dist x z) = z› using dist_triangle4 by auto
also have "... ≤ t + dist (f t) (f s) + (dist x z - s)"
using that 1 Ifg[of 0 t] Ifh[of s "dist x z"] by (auto simp add: dist_commute intro: mono_intros)
finally have "s - t ≤ dist (f t) (f s)" by auto
then show "dist (f s) (f t) = s-t" using * dist_commute by auto
next
case 2
then show ?thesis using Ifg that by auto
next
case 3
then show ?thesis using Ifh that by auto
qed
qed
have "isometry_on {0..dist x z} f"
unfolding isometry_on_def dist_real_def using I
by (auto, metis abs_of_nonneg dist_commute dist_real_def le_cases zero_le_dist)
then show "geodesic_segment_between (G ∪ H) x z"
unfolding geodesic_segment_between_def
using ‹f 0 = x› ‹f (dist x z) = z› ‹f`{0..dist x z} = G ∪ H› by auto
have "G ∩ H ⊆ {y}"
proof (auto)
fix a assume a: "a ∈ G" "a ∈ H"
obtain s where s: "s ∈ {0..dist x y}" "a = g s" using a g(4) by auto
obtain t where t: "t ∈ {dist x y..dist x z}" "a = h t" using a h(4) by auto
have "a = f s" using fg s by auto
moreover have "a = f t" using fh t by auto
ultimately have "s = t" using isometry_onD[OF ‹isometry_on {0..dist x z} f›, of s t] s(1) t(1) by auto
then have "s = dist x y" using s t by auto
then show "a = y" using s(2) g by auto
qed
then show "G ∩ H = {y}" using assms by auto
qed
lemma geodesic_segment_dist_le:
assumes "geodesic_segment_between G x y" "a ∈ G" "b ∈ G"
shows "dist a b ≤ dist x y"
proof -
obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
by (meson ‹geodesic_segment_between G x y› geodesic_segment_between_def)
obtain s t where st: "s ∈ {0..dist x y}" "t ∈ {0..dist x y}" "a = g s" "b = g t"
using g(4) assms by auto
have "dist a b = abs(s-t)" using isometry_onD[OF g(3) st(1) st(2)]
unfolding st(3) st(4) dist_real_def by simp
then show "dist a b ≤ dist x y" using st(1) st(2) unfolding dist_real_def by auto
qed
lemma geodesic_segment_param [simp]:
assumes "geodesic_segment_between G x y"
shows "geodesic_segment_param G x 0 = x"
"geodesic_segment_param G x (dist x y) = y"
"t ∈ {0..dist x y} ⟹ geodesic_segment_param G x t ∈ G"
"isometry_on {0..dist x y} (geodesic_segment_param G x)"
"(geodesic_segment_param G x)`{0..dist x y} = G"
"t ∈ {0..dist x y} ⟹ dist x (geodesic_segment_param G x t) = t"
"s ∈ {0..dist x y} ⟹ t ∈ {0..dist x y} ⟹ dist (geodesic_segment_param G x s) (geodesic_segment_param G x t) = abs(s-t)"
"z ∈ G ⟹ z = geodesic_segment_param G x (dist x z)"
proof -
obtain g::"real⇒'a" where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
by (meson ‹geodesic_segment_between G x y› geodesic_segment_between_def)
have *: "g t ∈ G ∧ dist x (g t) = t" if "t ∈ {0..dist x y}" for t
using isometry_onD[OF g(3), of 0 t] that g(1) g(4) unfolding dist_real_def by auto
have G: "geodesic_segment_param G x t = g t" if "t ∈ {0..dist x y}" for t
proof -
have A: "geodesic_segment_param G x t ∈ G ∧ dist x (geodesic_segment_param G x t) = t"
using *[OF that] unfolding geodesic_segment_param_def apply auto
using *[OF that] by (metis (mono_tags, lifting) someI)+
obtain s where s: "geodesic_segment_param G x t = g s" "s ∈ {0..dist x y}"
using A g(4) by auto
have "s = t" using *[OF ‹s ∈ {0..dist x y}›] A unfolding s(1) by auto
then show ?thesis using s by auto
qed
show "geodesic_segment_param G x 0 = x"
"geodesic_segment_param G x (dist x y) = y"
"t ∈ {0..dist x y} ⟹ geodesic_segment_param G x t ∈ G"
"isometry_on {0..dist x y} (geodesic_segment_param G x)"
"(geodesic_segment_param G x)`{0..dist x y} = G"
"t ∈ {0..dist x y} ⟹ dist x (geodesic_segment_param G x t) = t"
"s ∈ {0..dist x y} ⟹ t ∈ {0..dist x y} ⟹ dist (geodesic_segment_param G x s) (geodesic_segment_param G x t) = abs(s-t)"
"z ∈ G ⟹ z = geodesic_segment_param G x (dist x z)"
using G g apply (auto simp add: rev_image_eqI)
using G isometry_on_cong * atLeastAtMost_iff apply blast
using G isometry_on_cong * atLeastAtMost_iff apply blast
by (auto simp add: * dist_real_def isometry_onD)
qed
lemma geodesic_segment_param_in_segment:
assumes "G ≠ {}"
shows "geodesic_segment_param G x t ∈ G"
unfolding geodesic_segment_param_def
apply (auto, metis (mono_tags, lifting) someI)
using assms some_in_eq by fastforce
lemma geodesic_segment_reverse_param:
assumes "geodesic_segment_between G x y"
"t ∈ {0..dist x y}"
shows "geodesic_segment_param G y (dist x y - t) = geodesic_segment_param G x t"
proof -
have * [simp]: "geodesic_segment_between G y x"
using geodesic_segment_commute[OF assms(1)] by simp
have "geodesic_segment_param G y (dist x y - t) ∈ G"
apply (rule geodesic_segment_param(3)[of _ _ x])
using assms(2) by (auto simp add: dist_commute)
moreover have "dist (geodesic_segment_param G y (dist x y - t)) x = t"
using geodesic_segment_param(2)[OF *] geodesic_segment_param(7)[OF *, of "dist x y -t" "dist x y"] assms(2) by (auto simp add: dist_commute)
moreover have "geodesic_segment_param G x t ∈ G"
apply (rule geodesic_segment_param(3)[OF assms(1)])
using assms(2) by auto
moreover have "dist (geodesic_segment_param G x t) x = t"
using geodesic_segment_param(6)[OF assms] by (simp add: dist_commute)
ultimately show ?thesis
using geodesic_segment_dist_unique[OF assms(1)] by (simp add: dist_commute)
qed
lemma dist_along_geodesic_wrt_endpoint:
assumes "geodesic_segment_between G x y"
"u ∈ G" "v ∈ G"
shows "dist u v = abs(dist u x - dist v x)"
proof -
have *: "u = geodesic_segment_param G x (dist x u)" "v = geodesic_segment_param G x (dist x v)"
using assms by auto
have "dist u v = dist (geodesic_segment_param G x (dist x u)) (geodesic_segment_param G x (dist x v))"
using * by auto
also have "... = abs(dist x u - dist x v)"
apply (rule geodesic_segment_param(7)[OF assms(1)]) using assms apply auto
using geodesic_segment_dist_le geodesic_segment_endpoints(1) by blast+
finally show ?thesis by (simp add: dist_commute)
qed
text ‹One often needs to restrict a geodesic segment to a subsegment. We introduce the tools
to express this conveniently.›
definition geodesic_subsegment::"('a::metric_space) set ⇒ 'a ⇒ real ⇒ real ⇒ 'a set"
where "geodesic_subsegment G x s t = G ∩ {z. dist x z ≥ s ∧ dist x z ≤ t}"
text ‹A subsegment is always contained in the original segment.›
lemma geodesic_subsegment_subset:
"geodesic_subsegment G x s t ⊆ G"
unfolding geodesic_subsegment_def by simp
text ‹A subsegment is indeed a geodesic segment, and its endpoints and parametrization can be
expressed in terms of the original segment.›
lemma geodesic_subsegment:
assumes "geodesic_segment_between G x y"
"0 ≤ s" "s ≤ t" "t ≤ dist x y"
shows "geodesic_subsegment G x s t = (geodesic_segment_param G x)`{s..t}"
"geodesic_segment_between (geodesic_subsegment G x s t) (geodesic_segment_param G x s) (geodesic_segment_param G x t)"
"⋀u. s ≤ u ⟹ u ≤ t ⟹ geodesic_segment_param (geodesic_subsegment G x s t) (geodesic_segment_param G x s) (u - s) = geodesic_segment_param G x u"
proof -
show A: "geodesic_subsegment G x s t = (geodesic_segment_param G x)`{s..t}"
proof (auto)
fix y assume y: "y ∈ geodesic_subsegment G x s t"
have "y = geodesic_segment_param G x (dist x y)"
apply (rule geodesic_segment_param(8)[OF assms(1)])
using y geodesic_subsegment_subset by force
moreover have "dist x y ≥ s ∧ dist x y ≤ t"
using y unfolding geodesic_subsegment_def by auto
ultimately show "y ∈ geodesic_segment_param G x ` {s..t}" by auto
next
fix u assume H: "s ≤ u" "u ≤ t"
have *: "dist x (geodesic_segment_param G x u) = u"
apply (rule geodesic_segment_param(6)[OF assms(1)]) using H assms by auto
show "geodesic_segment_param G x u ∈ geodesic_subsegment G x s t"
unfolding geodesic_subsegment_def
using geodesic_segment_param_in_segment[OF geodesic_segment_endpoints(3)[OF assms(1)]] by (auto simp add: * H)
qed
have *: "isometry_on {s..t} (geodesic_segment_param G x)"
by (rule isometry_on_subset[of "{0..dist x y}"]) (auto simp add: assms)
show B: "geodesic_segment_between (geodesic_subsegment G x s t) (geodesic_segment_param G x s) (geodesic_segment_param G x t)"
unfolding A apply (rule geodesic_segmentI2) using * assms by auto
fix u assume u: "s ≤ u" "u ≤ t"
show "geodesic_segment_param (geodesic_subsegment G x s t) (geodesic_segment_param G x s) (u - s) = geodesic_segment_param G x u"
proof (rule geodesic_segment_dist_unique[OF B])
show "geodesic_segment_param (geodesic_subsegment G x s t) (geodesic_segment_param G x s) (u - s) ∈ geodesic_subsegment G x s t"
by (rule geodesic_segment_param_in_segment[OF geodesic_segment_endpoints(3)[OF B]])
show "geodesic_segment_param G x u ∈ geodesic_subsegment G x s t"
unfolding A using u by auto
have "dist (geodesic_segment_param G x s) (geodesic_segment_param (geodesic_subsegment G x s t) (geodesic_segment_param G x s) (u - s)) = u - s"
using B assms u by auto
moreover have "dist (geodesic_segment_param G x s) (geodesic_segment_param G x u) = u -s"
using assms u by auto
ultimately show "dist (geodesic_segment_param G x s) (geodesic_segment_param (geodesic_subsegment G x s t) (geodesic_segment_param G x s) (u - s)) =
dist (geodesic_segment_param G x s) (geodesic_segment_param G x u)"
by simp
qed
qed
text ‹The parameterizations of a segment and a subsegment sharing an endpoint coincide where defined.›
lemma geodesic_segment_subparam:
assumes "geodesic_segment_between G x z" "geodesic_segment_between H x y" "H ⊆ G" "t ∈ {0..dist x y}"
shows "geodesic_segment_param G x t = geodesic_segment_param H x t"
proof -
have "geodesic_segment_param H x t ∈ G"
using assms(3) geodesic_segment_param(3)[OF assms(2) assms(4)] by auto
then have "geodesic_segment_param H x t = geodesic_segment_param G x (dist x (geodesic_segment_param H x t))"
using geodesic_segment_param(8)[OF assms(1)] by auto
then show ?thesis using geodesic_segment_param(6)[OF assms(2) assms(4)] by auto
qed
text ‹A segment contains a subsegment between any of its points›
lemma geodesic_subsegment_exists:
assumes "geodesic_segment G" "x ∈ G" "y ∈ G"
shows "∃H. H ⊆ G ∧ geodesic_segment_between H x y"
proof -
obtain a0 b0 where Ga0b0: "geodesic_segment_between G a0 b0"
using assms(1) unfolding geodesic_segment_def by auto
text ‹Permuting the endpoints if necessary, we can ensure that the first endpoint $a$ is closer
to $x$ than $y$.›
have "∃ a b. geodesic_segment_between G a b ∧ dist x a ≤ dist y a"
proof (cases "dist x a0 ≤ dist y a0")
case True
show ?thesis
apply (rule exI[of _ a0], rule exI[of _ b0]) using True Ga0b0 by auto
next
case False
show ?thesis
apply (rule exI[of _ b0], rule exI[of _ a0])
using Ga0b0 geodesic_segment_commute geodesic_segment_dist[OF Ga0b0 ‹x ∈ G›] geodesic_segment_dist[OF Ga0b0 ‹y ∈ G›] False
by (auto simp add: dist_commute)
qed
then obtain a b where Gab: "geodesic_segment_between G a b" "dist x a ≤ dist y a"
by auto
have *: "0 ≤ dist x a" "dist x a ≤ dist y a" "dist y a ≤ dist a b"
using Gab assms by (meson geodesic_segment_dist_le geodesic_segment_endpoints(1) zero_le_dist)+
have **: "x = geodesic_segment_param G a (dist x a)" "y = geodesic_segment_param G a (dist y a)"
using Gab ‹x ∈ G› ‹y ∈ G› by (metis dist_commute geodesic_segment_param(8))+
define H where "H = geodesic_subsegment G a (dist x a) (dist y a)"
have "H ⊆ G"
unfolding H_def by (rule geodesic_subsegment_subset)
moreover have "geodesic_segment_between H x y"
unfolding H_def using geodesic_subsegment(2)[OF Gab(1) *] ** by auto
ultimately show ?thesis by auto
qed
text ‹A geodesic segment is homeomorphic to an interval.›
lemma geodesic_segment_homeo_interval:
assumes "geodesic_segment_between G x y"
shows "{0..dist x y} homeomorphic G"
proof -
obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
by (meson ‹geodesic_segment_between G x y› geodesic_segment_between_def)
show ?thesis using isometry_on_homeomorphism(3)[OF g(3)] unfolding g(4) by simp
qed
text ‹Just like an interval, a geodesic segment is compact, connected, path connected, bounded,
closed, nonempty, and proper.›
lemma geodesic_segment_topology:
assumes "geodesic_segment G"
shows "compact G" "connected G" "path_connected G" "bounded G" "closed G" "G ≠ {}" "proper G"
proof -
show "compact G"
using assms geodesic_segment_homeo_interval homeomorphic_compactness
unfolding geodesic_segment_def by force
show "path_connected G"
using assms is_interval_path_connected geodesic_segment_homeo_interval homeomorphic_path_connectedness
unfolding geodesic_segment_def
by (metis is_interval_cc)
then show "connected G"
using path_connected_imp_connected by auto
show "bounded G"
by (rule compact_imp_bounded, fact)
show "closed G"
by (rule compact_imp_closed, fact)
show "G ≠ {}"
using assms geodesic_segment_def geodesic_segment_endpoints(3) by auto
show "proper G"
using proper_of_compact ‹compact G› by auto
qed
lemma geodesic_segment_between_x_x [simp]:
"geodesic_segment_between {x} x x"
"geodesic_segment {x}"
"geodesic_segment_between G x x ⟷ G = {x}"
proof -
show *: "geodesic_segment_between {x} x x"
unfolding geodesic_segment_between_def apply (rule exI[of _ "λ_. x"]) unfolding isometry_on_def by auto
then show "geodesic_segment {x}" by auto
show "geodesic_segment_between G x x ⟷ G = {x}"
using geodesic_segment_dist_le geodesic_segment_endpoints(2) * by fastforce
qed
lemma geodesic_segment_disconnection:
assumes "geodesic_segment_between G x y" "z ∈ G"
shows "(connected (G - {z})) = (z = x ∨ z = y)"
proof -
obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
by (meson ‹geodesic_segment_between G x y› geodesic_segment_between_def)
obtain t where t: "t ∈ {0..dist x y}" "z = g t" using ‹z ∈ G› g(4) by auto
have "({0..dist x y} - {t}) homeomorphic (G - {g t})"
proof -
have *: "isometry_on ({0..dist x y} - {t}) g"
apply (rule isometry_on_subset[OF g(3)]) by auto
have "({0..dist x y} - {t}) homeomorphic g`({0..dist x y} - {t})"
by (rule isometry_on_homeomorphism(3)[OF *])
moreover have "g`({0..dist x y} - {t}) = G - {g t}"
unfolding g(4) using isometry_on_injective[OF g(3)] t by (auto simp add: inj_onD)
ultimately show ?thesis by auto
qed
moreover have "connected({0..dist x y} - {t}) = (t = 0 ∨ t = dist x y)"
using t(1) by (auto simp add: connected_iff_interval, fastforce)
ultimately have "connected (G - {z}) = (t = 0 ∨ t = dist x y)"
unfolding ‹z = g t›[symmetric]using homeomorphic_connectedness by blast
moreover have "(t = 0 ∨ t = dist x y) = (z = x ∨ z = y)"
using t g apply auto
by (metis atLeastAtMost_iff isometry_on_inverse(2) order_refl zero_le_dist)+
ultimately show ?thesis by auto
qed
lemma geodesic_segment_unique_endpoints:
assumes "geodesic_segment_between G x y"
"geodesic_segment_between G a b"
shows "{x, y} = {a, b}"
by (metis geodesic_segment_disconnection assms(1) assms(2) doubleton_eq_iff geodesic_segment_endpoints(1) geodesic_segment_endpoints(2))
lemma geodesic_segment_subsegment:
assumes "geodesic_segment G" "H ⊆ G" "compact H" "connected H" "H ≠ {}"
shows "geodesic_segment H"
proof -
obtain x y where "geodesic_segment_between G x y"
using assms unfolding geodesic_segment_def by auto
obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
by (meson ‹geodesic_segment_between G x y› geodesic_segment_between_def)
define L where "L = (inv_into {0..dist x y} g)`H"
have "L ⊆ {0..dist x y}"
unfolding L_def using isometry_on_inverse[OF ‹isometry_on {0..dist x y} g›] assms(2) g(4) by auto
have "isometry_on G (inv_into {0..dist x y} g)"
using isometry_on_inverse[OF ‹isometry_on {0..dist x y} g›] g(4) by auto
then have "isometry_on H (inv_into {0..dist x y} g)"
using ‹H ⊆ G› isometry_on_subset by auto
then have "H homeomorphic L" unfolding L_def using isometry_on_homeomorphism(3) by auto
then have "compact L ∧ connected L"
using assms homeomorphic_compactness homeomorphic_connectedness by blast
then obtain a b where "L = {a..b}"
using connected_compact_interval_1[of L] by auto
have "a ≤ b" using ‹H ≠ {}› ‹L = {a..b}› unfolding L_def by auto
then have "0 ≤ a" "b ≤ dist x y" using ‹L ⊆ {0..dist x y}› ‹L = {a..b}› by auto
have *: "H = g`{a..b}"
by (metis L_def ‹L = {a..b}› assms(2) g(4) image_inv_into_cancel)
show "geodesic_segment H"
unfolding * apply (rule geodesic_segmentI2[OF _ ‹a ≤ b›])
apply (rule isometry_on_subset[OF g(3)]) using ‹0 ≤ a› ‹b ≤ dist x y› by auto
qed
text ‹The image under an isometry of a geodesic segment is still obviously a geodesic segment.›
lemma isometry_preserves_geodesic_segment_between:
assumes "isometry_on X f"
"G ⊆ X" "geodesic_segment_between G x y"
shows "geodesic_segment_between (f`G) (f x) (f y)"
proof -
obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
by (meson ‹geodesic_segment_between G x y› geodesic_segment_between_def)
then have *: "f`G = (f o g) `{0..dist x y}" "f x = (f o g) 0" "f y = (f o g) (dist x y)"
by auto
show ?thesis
unfolding * apply (intro geodesic_segmentI2(1))
unfolding comp_def apply (rule isometry_on_compose[of _ g])
using g(3) g(4) assms by (auto intro: isometry_on_subset)
qed
text ‹The sum of distances $d(w, x) + d(w, y)$ can be controlled using the distance from $w$
to a geodesic segment between $x$ and $y$.›
lemma geodesic_segment_distance:
assumes "geodesic_segment_between G x y"
shows "dist w x + dist w y ≤ dist x y + 2 * infdist w G"
proof -
have "∃z ∈ G. infdist w G = dist w z"
apply (rule infdist_proper_attained) using assms by (auto simp add: geodesic_segment_topology)
then obtain z where z: "z ∈ G" "infdist w G = dist w z" by auto
have "dist w x + dist w y ≤ (dist w z + dist z x) + (dist w z + dist z y)"
by (intro mono_intros)
also have "... = dist x z + dist z y + 2 * dist w z"
by (auto simp add: dist_commute)
also have "... = dist x y + 2 * infdist w G"
using z(1) assms geodesic_segment_dist unfolding z(2) by auto
finally show ?thesis by auto
qed
text ‹If a point $y$ is on a geodesic segment between $x$ and its closest projection $p$ on a set $A$,
then $p$ is also a closest projection of $y$, and the closest projection set of $y$ is contained in
that of $x$.›
lemma proj_set_geodesic_same_basepoint:
assumes "p ∈ proj_set x A" "geodesic_segment_between G p x" "y ∈ G"
shows "p ∈ proj_set y A"
proof (rule proj_setI)
show "p ∈ A"
using assms proj_setD by auto
have *: "dist y p ≤ dist y q" if "q ∈ A" for q
proof -
have "dist p y + dist y x = dist p x"
using assms geodesic_segment_dist by blast
also have "... ≤ dist q x"
using proj_set_dist_le[OF ‹q ∈ A› assms(1)] by (simp add: dist_commute)
also have "... ≤ dist q y + dist y x"
by (intro mono_intros)
finally show ?thesis
by (simp add: dist_commute)
qed
have "dist y p ≤ Inf (dist y ` A)"
apply (rule cINF_greatest) using ‹p ∈ A› * by auto
then show "dist y p ≤ infdist y A"
unfolding infdist_def using ‹p ∈ A› by auto
qed
lemma proj_set_subset:
assumes "p ∈ proj_set x A" "geodesic_segment_between G p x" "y ∈ G"
shows "proj_set y A ⊆ proj_set x A"
proof -
have "z ∈ proj_set x A" if "z ∈ proj_set y A" for z
proof (rule proj_setI)
show "z ∈ A" using that proj_setD by auto
have "dist x z ≤ dist x y + dist y z"
by (intro mono_intros)
also have "... ≤ dist x y + dist y p"
using proj_set_dist_le[OF proj_setD(1)[OF ‹p ∈ proj_set x A›] that] by auto
also have "... = dist x p"
using assms geodesic_segment_commute geodesic_segment_dist by blast
also have "... = infdist x A"
using proj_setD(2)[OF assms(1)] by simp
finally show "dist x z ≤ infdist x A"
by simp
qed
then show ?thesis by auto
qed
lemma proj_set_thickening:
assumes "p ∈ proj_set x Z"
"0 ≤ D"
"D ≤ dist p x"
"geodesic_segment_between G p x"
shows "geodesic_segment_param G p D ∈ proj_set x (⋃z∈Z. cball z D)"
proof (rule proj_setI')
have "dist p (geodesic_segment_param G p D) = D"
using geodesic_segment_param(7)[OF assms(4), of 0 D]
unfolding geodesic_segment_param(1)[OF assms(4)] using assms by simp
then show "geodesic_segment_param G p D ∈ (⋃z∈Z. cball z D)"
using proj_setD(1)[OF ‹p ∈ proj_set x Z›] by force
show "dist x (geodesic_segment_param G p D) ≤ dist x y" if "y ∈ (⋃z∈Z. cball z D)" for y
proof -
obtain z where y: "y ∈ cball z D" "z ∈ Z" using ‹y ∈ (⋃z∈Z. cball z D)› by auto
have "dist (geodesic_segment_param G p D) x + D = dist p x"
using geodesic_segment_param(7)[OF assms(4), of D "dist p x"]
unfolding geodesic_segment_param(2)[OF assms(4)] using assms by simp
also have "... ≤ dist z x"
using proj_setD(2)[OF ‹p ∈ proj_set x Z›] infdist_le[OF ‹z ∈ Z›, of x] by (simp add: dist_commute)
also have "... ≤ dist z y + dist y x"
by (intro mono_intros)
also have "... ≤ D + dist y x"
using y by simp
finally show ?thesis by (simp add: dist_commute)
qed
qed
lemma proj_set_thickening':
assumes "p ∈ proj_set x Z"
"0 ≤ D"
"D ≤ E"
"E ≤ dist p x"
"geodesic_segment_between G p x"
shows "geodesic_segment_param G p D ∈ proj_set (geodesic_segment_param G p E) (⋃z∈Z. cball z D)"
proof -
define H where "H = geodesic_subsegment G p D (dist p x)"
have H1: "geodesic_segment_between H (geodesic_segment_param G p D) x"
apply (subst geodesic_segment_param(2)[OF ‹geodesic_segment_between G p x›, symmetric])
unfolding H_def apply (rule geodesic_subsegment(2)) using assms by auto
have H2: "geodesic_segment_param G p E ∈ H"
unfolding H_def using assms geodesic_subsegment(1) by force
have "geodesic_segment_param G p D ∈ proj_set x (⋃z∈Z. cball z D)"
apply (rule proj_set_thickening) using assms by auto
then show ?thesis
by (rule proj_set_geodesic_same_basepoint[OF _ H1 H2])
qed
text ‹It is often convenient to use \emph{one} geodesic between $x$ and $y$, even if it is not unique.
We introduce a notation for such a choice of a geodesic, denoted \verb+{x--S--y}+ for such a geodesic
that moreover remains in the set $S$. We also enforce
the condition \verb+{x--S--y} = {y--S--x}+. When there is no such geodesic, we simply take
\verb+{x--S--y} = {x, y}+ for definiteness. It would be even better to enforce that, if
$a$ is on \verb+{x--S--y}+, then \verb+{x--S--y}+ is the union of \verb+{x--S--a}+ and \verb+{a--S--y}+, but
I do not know if such a choice is always possible -- such a choice of geodesics is
called a geodesic bicombing.
We also write \verb+{x--y}+ for \verb+{x--UNIV--y}+.›
definition some_geodesic_segment_between::"'a::metric_space ⇒ 'a set ⇒ 'a ⇒ 'a set" ("(1{_--_--_})")
where "some_geodesic_segment_between = (SOME f. ∀ x y S. f x S y = f y S x
∧ (if (∃G. geodesic_segment_between G x y ∧ G ⊆ S) then (geodesic_segment_between (f x S y) x y ∧ (f x S y ⊆ S))
else f x S y = {x, y}))"
abbreviation some_geodesic_segment_between_UNIV::"'a::metric_space ⇒ 'a ⇒ 'a set" ("(1{_--_})")
where "some_geodesic_segment_between_UNIV x y ≡ {x--UNIV--y}"
text ‹We prove that there is such a choice of geodesics, compatible with direction reversal. What
we do is choose arbitrarily a geodesic between $x$ and $y$ if it exists, and then use the geodesic
between $\min(x, y)$ and $\max(x,y)$, for any total order on the space, to ensure that we get the
same result from $x$ to $y$ or from $y$ to $x$.›
lemma some_geodesic_segment_between_exists:
"∃f. ∀ x y S. f x S y = f y S x
∧ (if (∃G. geodesic_segment_between G x y ∧ G ⊆ S) then (geodesic_segment_between (f x S y) x y ∧ (f x S y ⊆ S))
else f x S y = {x, y})"
proof -
define g::"'a ⇒ 'a set ⇒ 'a ⇒ 'a set" where
"g = (λx S y. if (∃G. geodesic_segment_between G x y ∧ G ⊆ S) then (SOME G. geodesic_segment_between G x y ∧ G ⊆ S) else {x, y})"
have g1: "geodesic_segment_between (g x S y) x y ∧ (g x S y ⊆ S)" if "∃G. geodesic_segment_between G x y ∧ G ⊆ S" for x y S
unfolding g_def using someI_ex[OF that] by auto
have g2: "g x S y = {x, y}" if "¬(∃G. geodesic_segment_between G x y ∧ G ⊆ S)" for x y S
unfolding g_def using that by auto
obtain r::"'a rel" where r: "well_order_on UNIV r"
using well_order_on by auto
have A: "x = y" if "(x, y) ∈ r" "(y, x) ∈ r" for x y
using r that unfolding well_order_on_def linear_order_on_def partial_order_on_def antisym_def by auto
have B: "(x, y) ∈ r ∨ (y, x) ∈ r" for x y
using r unfolding well_order_on_def linear_order_on_def total_on_def partial_order_on_def preorder_on_def refl_on_def by force
define f where "f = (λx S y. if (x, y) ∈ r then g x S y else g y S x)"
have "f x S y = f y S x" for x y S unfolding f_def using r A B by auto
moreover have "geodesic_segment_between (f x S y) x y ∧ (f x S y ⊆ S)" if "∃G. geodesic_segment_between G x y ∧ G ⊆ S" for x y S
unfolding f_def using g1 geodesic_segment_commute that by smt
moreover have "f x S y = {x, y}" if "¬(∃G. geodesic_segment_between G x y ∧ G ⊆ S)" for x y S
unfolding f_def using g2 that geodesic_segment_commute doubleton_eq_iff by metis
ultimately show ?thesis by metis
qed
lemma some_geodesic_commute:
"{x--S--y} = {y--S--x}"
unfolding some_geodesic_segment_between_def by (auto simp add: someI_ex[OF some_geodesic_segment_between_exists])
lemma some_geodesic_segment_description:
"(∃G. geodesic_segment_between G x y ∧ G ⊆ S) ⟹ geodesic_segment_between {x--S--y} x y"
"(¬(∃G. geodesic_segment_between G x y ∧ G ⊆ S)) ⟹ {x--S--y} = {x, y}"
unfolding some_geodesic_segment_between_def by (simp add: someI_ex[OF some_geodesic_segment_between_exists])+
text ‹Basic topological properties of our chosen set of geodesics.›
lemma some_geodesic_compact [simp]:
"compact {x--S--y}"
apply (cases "∃G. geodesic_segment_between G x y ∧ G ⊆ S")
using some_geodesic_segment_description[of x y] geodesic_segment_topology[of "{x--S--y}"] geodesic_segment_def apply auto
by blast
lemma some_geodesic_closed [simp]:
"closed {x--S--y}"
by (rule compact_imp_closed[OF some_geodesic_compact[of x S y]])
lemma some_geodesic_bounded [simp]:
"bounded {x--S--y}"
by (rule compact_imp_bounded[OF some_geodesic_compact[of x S y]])
lemma some_geodesic_endpoints [simp]:
"x ∈ {x--S--y}" "y ∈ {x--S--y}" "{x--S--y} ≠ {}"
apply (cases "∃G. geodesic_segment_between G x y ∧ G ⊆ S") using some_geodesic_segment_description[of x y S] apply auto
apply (cases "∃G. geodesic_segment_between G x y ∧ G ⊆ S") using some_geodesic_segment_description[of x y S] apply auto
apply (cases "∃G. geodesic_segment_between G x y ∧ G ⊆ S") using geodesic_segment_endpoints(3) by (auto, blast)
lemma some_geodesic_subsegment:
assumes "H ⊆ {x--S--y}" "compact H" "connected H" "H ≠ {}"
shows "geodesic_segment H"
apply (cases "∃G. geodesic_segment_between G x y ∧ G ⊆ S")
using some_geodesic_segment_description[of x y] geodesic_segment_subsegment[OF _ assms] geodesic_segment_def apply auto[1]
using some_geodesic_segment_description[of x y] assms
by (metis connected_finite_iff_sing finite.emptyI finite.insertI finite_subset geodesic_segment_between_x_x(2))
lemma some_geodesic_in_subset:
assumes "x ∈ S" "y ∈ S"
shows "{x--S--y} ⊆ S"
apply (cases "∃G. geodesic_segment_between G x y ∧ G ⊆ S")
unfolding some_geodesic_segment_between_def by (simp add: assms someI_ex[OF some_geodesic_segment_between_exists])+
lemma some_geodesic_same_endpoints [simp]:
"{x--S--x} = {x}"
apply (cases "∃G. geodesic_segment_between G x x ∧ G ⊆ S")
apply (meson geodesic_segment_between_x_x(3) some_geodesic_segment_description(1))
by (simp add: some_geodesic_segment_description(2))
subsection ‹Geodesic subsets›
text ‹A subset is \emph{geodesic} if any two of its points can be joined by a geodesic segment.
We prove basic properties of such a subset in this paragraph -- notably connectedness. A basic
example is given by convex subsets of vector spaces, as closed segments are geodesic.›
definition geodesic_subset::"('a::metric_space) set ⇒ bool"
where "geodesic_subset S = (∀x∈S. ∀y∈S. ∃G. geodesic_segment_between G x y ∧ G ⊆ S)"
lemma geodesic_subsetD:
assumes "geodesic_subset S" "x ∈ S" "y ∈ S"
shows "geodesic_segment_between {x--S--y} x y"
using assms some_geodesic_segment_description(1) unfolding geodesic_subset_def by blast
lemma geodesic_subsetI:
assumes "⋀x y. x ∈ S ⟹ y ∈ S ⟹ ∃G. geodesic_segment_between G x y ∧ G ⊆ S"
shows "geodesic_subset S"
using assms unfolding geodesic_subset_def by auto
lemma geodesic_subset_empty:
"geodesic_subset {}"
using geodesic_subsetI by auto
lemma geodesic_subset_singleton:
"geodesic_subset {x}"
by (auto intro!: geodesic_subsetI geodesic_segment_between_x_x(1))
lemma geodesic_subset_path_connected:
assumes "geodesic_subset S"
shows "path_connected S"
proof -
have "∃g. path g ∧ path_image g ⊆ S ∧ pathstart g = x ∧ pathfinish g = y" if "x ∈ S" "y ∈ S" for x y
proof -
define G where "G = {x--S--y}"
have *: "geodesic_segment_between G x y" "G ⊆ S" "x ∈ G" "y ∈ G"
using assms that by (auto simp add: G_def geodesic_subsetD some_geodesic_in_subset that(1) that(2))
then have "path_connected G"
using geodesic_segment_topology(3) unfolding geodesic_segment_def by auto
then have "∃g. path g ∧ path_image g ⊆ G ∧ pathstart g = x ∧ pathfinish g = y"
using * unfolding path_connected_def by auto
then show ?thesis using ‹G ⊆ S› by auto
qed
then show ?thesis
unfolding path_connected_def by auto
qed
text ‹To show that a segment in a normed vector space is geodesic, we will need to use its
length parametrization, which is given in the next lemma.›
lemma closed_segment_as_isometric_image:
"((λt. x + (t/dist x y) *⇩R (y - x))`{0..dist x y}) = closed_segment x y"
proof (auto simp add: closed_segment_def image_iff)
fix t assume H: "0 ≤ t" "t ≤ dist x y"
show "∃u. x + (t / dist x y) *⇩R (y - x) = (1 - u) *⇩R x + u *⇩R y ∧ 0 ≤ u ∧ u ≤ 1"
apply (rule exI[of _ "t/dist x y"])
using H apply (auto simp add: algebra_simps divide_simps)
apply (metis add_diff_cancel_left' add_diff_eq add_divide_distrib dist_eq_0_iff scaleR_add_left vector_fraction_eq_iff)
done
next
fix u::real assume H: "0 ≤ u" "u ≤ 1"
show "∃t∈{0..dist x y}. (1 - u) *⇩R x + u *⇩R y = x + (t / dist x y) *⇩R (y - x)"
apply (rule bexI[of _ "u * dist x y"])
using H by (auto simp add: algebra_simps mult_left_le_one_le)
qed
proposition closed_segment_is_geodesic:
fixes x y::"'a::real_normed_vector"
shows "isometry_on {0..dist x y} (λt. x + (t/dist x y) *⇩R (y - x))"
"geodesic_segment_between (closed_segment x y) x y"
"geodesic_segment (closed_segment x y)"
proof -
show *: "isometry_on {0..dist x y} (λt. x + (t/dist x y) *⇩R (y - x))"
unfolding isometry_on_def dist_norm
apply (cases "x = y")
by (auto simp add: scaleR_diff_left[symmetric] diff_divide_distrib[symmetric] norm_minus_commute)
show "geodesic_segment_between (closed_segment x y) x y"
unfolding closed_segment_as_isometric_image[symmetric]
apply (rule geodesic_segment_betweenI[OF _ _ *]) by auto
then show "geodesic_segment (closed_segment x y)"
by auto
qed
text ‹We deduce that a convex set is geodesic.›
proposition convex_is_geodesic:
assumes "convex (S::'a::real_normed_vector set)"
shows "geodesic_subset S"
proof (rule geodesic_subsetI)
fix x y assume H: "x ∈ S" "y ∈ S"
show "∃G. geodesic_segment_between G x y ∧ G ⊆ S"
apply (rule exI[of _ "closed_segment x y"])
apply (auto simp add: closed_segment_is_geodesic)
using H assms convex_contains_segment by blast
qed
subsection ‹Geodesic spaces›
text ‹In this subsection, we define geodesic spaces (metric spaces in which there is a geodesic
segment joining any pair of points). We specialize the previous statements on geodesic segments to
these situations.›
class geodesic_space = metric_space +
assumes geodesic: "geodesic_subset (UNIV::('a::metric_space) set)"
text ‹The simplest example of a geodesic space is a real normed vector space. Significant examples
also include graphs (with the graph distance), Riemannian manifolds, and $CAT(\kappa)$ spaces.›
instance real_normed_vector ⊆ geodesic_space
by (standard, simp add: convex_is_geodesic)
lemma (in geodesic_space) some_geodesic_is_geodesic_segment [simp]:
"geodesic_segment_between {x--y} x (y::'a)"
"geodesic_segment {x--y}"
using some_geodesic_segment_description(1)[of x y] geodesic_subsetD[OF geodesic] by (auto, blast)
lemma (in geodesic_space) some_geodesic_connected [simp]:
"connected {x--y}" "path_connected {x--y}"
by (auto intro!: geodesic_segment_topology)
text ‹In geodesic spaces, we restate as simp rules all properties of the geodesic segment
parametrizations.›
lemma (in geodesic_space) geodesic_segment_param_in_geodesic_spaces [simp]:
"geodesic_segment_param {x--y} x 0 = x"
"geodesic_segment_param {x--y} x (dist x y) = y"
"t ∈ {0..dist x y} ⟹ geodesic_segment_param {x--y} x t ∈ {x--y}"
"isometry_on {0..dist x y} (geodesic_segment_param {x--y} x)"
"(geodesic_segment_param {x--y} x)`{0..dist x y} = {x--y}"
"t ∈ {0..dist x y} ⟹ dist x (geodesic_segment_param {x--y} x t) = t"
"s ∈ {0..dist x y} ⟹ t ∈ {0..dist x y} ⟹ dist (geodesic_segment_param {x--y} x s) (geodesic_segment_param {x--y} x t) = abs(s-t)"
"z ∈ {x--y} ⟹ z = geodesic_segment_param {x--y} x (dist x z)"
using geodesic_segment_param[OF some_geodesic_is_geodesic_segment(1)[of x y]] by auto
subsection ‹Uniquely geodesic spaces›
text ‹In this subsection, we define uniquely geodesic spaces, i.e., geodesic spaces in which,
additionally, there is a unique geodesic between any pair of points.›
class uniquely_geodesic_space = geodesic_space +
assumes uniquely_geodesic: "⋀x y G H. geodesic_segment_between G x y ⟹ geodesic_segment_between H x y ⟹ G = H"
text ‹To prove that a geodesic space is uniquely geodesic, it suffices to show that there is no loop,
i.e., if two geodesic segments intersect only at their endpoints, then they coincide.
Indeed, assume this holds, and consider two geodesics with the same endpoints. If they differ at
some time $t$, then consider the last time $a$ before $t$ where they coincide, and the first time
$b$ after $t$ where they coincide. Then the restrictions of the two geodesics to $[a,b]$ give
a loop, and a contradiction.›
lemma (in geodesic_space) uniquely_geodesic_spaceI:
assumes "⋀G H x (y::'a). geodesic_segment_between G x y ⟹ geodesic_segment_between H x y ⟹ G ∩ H = {x, y} ⟹ x = y"
"geodesic_segment_between G x y" "geodesic_segment_between H x (y::'a)"
shows "G = H"
proof -
obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
by (meson ‹geodesic_segment_between G x y› geodesic_segment_between_def)
obtain h where h: "h 0 = x" "h (dist x y) = y" "isometry_on {0..dist x y} h" "H = h`{0..dist x y}"
by (meson ‹geodesic_segment_between H x y› geodesic_segment_between_def)
have "g t = h t" if "t ∈ {0..dist x y}" for t
proof (rule ccontr)
assume "g t ≠ h t"
define Z where "Z = {s ∈ {0..dist x y}. g s = h s}"
have "0 ∈ Z" "dist x y ∈ Z" unfolding Z_def using g h by auto
have "t ∉ Z" unfolding Z_def using ‹g t ≠ h t› by auto
have [simp]: "closed Z"
proof -
have *: "Z = (λs. dist (g s) (h s))-`{0} ∩ {0..dist x y}"
unfolding Z_def by auto
show ?thesis
unfolding * apply (rule closed_vimage_Int)
using isometry_on_continuous[OF g(3)] isometry_on_continuous[OF h(3)] continuous_on_dist by auto
qed
define a where "a = Sup (Z ∩ {0..t})"
have a: "a ∈ Z ∩ {0..t}"
unfolding a_def apply (rule closed_contains_Sup, auto)
using ‹0 ∈ Z› that by auto
then have "h a = g a" unfolding Z_def by auto
define b where "b = Inf (Z ∩ {t..dist x y})"
have b: "b ∈ Z ∩ {t..dist x y}"
unfolding b_def apply (rule closed_contains_Inf, auto)
using ‹dist x y ∈ Z› that by auto
then have "h b = g b" unfolding Z_def by auto
have notZ: "s ∉ Z" if "s ∈ {a<..<b}" for s
proof (rule ccontr, auto, cases "s ≤ t")
case True
assume "s ∈ Z"
then have *: "s ∈ Z ∩ {0..t}" using that a True by auto
have "s ≤ a" unfolding a_def apply (rule cSup_upper) using * by auto
then show False using that by auto
next
case False
assume "s ∈ Z"
then have *: "s ∈ Z ∩ {t..dist x y}" using that b False by auto
have "s ≥ b" unfolding b_def apply (rule cInf_lower) using * by auto
then show False using that by auto
qed
have "t ∈ {a<..<b}" using a b ‹t ∉ Z› less_eq_real_def by auto
then have "a ≤ b" by auto
then have "dist (h a) (h b) = b-a"
using isometry_onD[OF h(3), of a b] a b that unfolding dist_real_def by auto
then have "dist (h a) (h b) > 0" using ‹t ∈ {a<..<b}› by auto
then have "h a ≠ h b" by auto
define G2 where "G2 = g`{a..b}"
define H2 where "H2 = h`{a..b}"
have "G2 ∩ H2 ⊆ {h a, h b}"
proof
fix z assume z: "z ∈ G2 ∩ H2"
obtain sg where sg: "z = g sg" "sg ∈ {a..b}" using z unfolding G2_def by auto
obtain sh where sh: "z = h sh" "sh ∈ {a..b}" using z unfolding H2_def by auto
have "sg = dist x z"
using isometry_onD[OF g(3), of 0 sg] a b sg(2) unfolding sg(1) g(1)[symmetric] dist_real_def by auto
moreover have "sh = dist x z"
using isometry_onD[OF h(3), of 0 sh] a b sh(2) unfolding sh(1) h(1)[symmetric] dist_real_def by auto
ultimately have "sg = sh" by auto
then have "sh ∈ Z" using sg(1) sh(1) a b sh(2) unfolding Z_def by auto
then have "sh ∈ {a, b}" using notZ sh(2)
by (metis IntD2 atLeastAtMost_iff atLeastAtMost_singleton greaterThanLessThan_iff inf_bot_left insertI2 insert_inter_insert not_le)
then show "z ∈ {h a, h b}" using sh(1) by auto
qed
then have "G2 ∩ H2 = {h a, h b}"
using ‹h a = g a› ‹h b = g b› ‹a ≤ b› unfolding H2_def G2_def apply auto
unfolding ‹h a = g a›[symmetric] ‹h b = g b›[symmetric] by auto
moreover have "geodesic_segment_between G2 (h a) (h b)"
unfolding G2_def ‹h a = g a› ‹h b = g b›
apply (rule geodesic_segmentI2) apply (rule isometry_on_subset[OF g(3)])
using a b that by auto
moreover have "geodesic_segment_between H2 (h a) (h b)"
unfolding H2_def apply (rule geodesic_segmentI2) apply (rule isometry_on_subset[OF h(3)])
using a b that by auto
ultimately have "h a = h b" using assms(1) by auto
then show False using ‹h a ≠ h b› by simp
qed
then show "G = H" using g(4) h(4) by (simp add: image_def)
qed
context uniquely_geodesic_space
begin
lemma geodesic_segment_unique:
"geodesic_segment_between G x y = (G = {x--(y::'a)})"
using uniquely_geodesic[of _ x y] by (meson some_geodesic_is_geodesic_segment)
lemma geodesic_segment_dist':
assumes "dist x z = dist x y + dist y z"
shows "y ∈ {x--z}" "{x--z} = {x--y} ∪ {y--z}"
proof -
have "geodesic_segment_between ({x--y} ∪ {y--z}) x z"
using geodesic_segment_union[OF assms] by auto
then show "{x--z} = {x--y} ∪ {y--z}"
using geodesic_segment_unique by auto
then show "y ∈ {x--z}" by auto
qed
lemma geodesic_segment_expression:
"{x--z} = {y. dist x z = dist x y + dist y z}"
using geodesic_segment_dist'(1) geodesic_segment_dist[OF some_geodesic_is_geodesic_segment(1)] by auto
lemma geodesic_segment_split:
assumes "(y::'a) ∈ {x--z}"
shows "{x--z} = {x--y} ∪ {y--z}"
"{x--y} ∩ {y--z} = {y}"
apply (metis assms geodesic_segment_dist geodesic_segment_dist'(2) some_geodesic_is_geodesic_segment(1))
apply (rule geodesic_segment_union(2)[of x z], auto simp add: assms)
using assms geodesic_segment_expression by blast
lemma geodesic_segment_subparam':
assumes "y ∈ {x--z}" "t ∈ {0..dist x y}"
shows "geodesic_segment_param {x--z} x t = geodesic_segment_param {x--y} x t"
apply (rule geodesic_segment_subparam[of _ _ z _ y]) using assms apply auto
using geodesic_segment_split(1)[OF assms(1)] by auto
end
subsection ‹A complete metric space with middles is geodesic.›
text ‹A complete space in which every pair of points has a middle (i.e., a point $m$ which
is half distance of $x$ and $y$) is geodesic: to construct a geodesic between $x_0$
and $y_0$, first choose a middle $m$, then middles of the pairs $(x_0,m)$ and $(m, y_0)$, and so
on. This will define the geodesic on dyadic points (and this is indeed an isometry on these dyadic
points. Then, extend it by uniform continuity to the whole segment $[0, dist x0 y0]$.
The formal proof will be done in a locale where $x_0$ and $y_0$ are fixed, for notational simplicity.
We define inductively the sequence of middles, in a function \verb+geod+ of two natural variables:
$geod n m$ corresponds to the image of the dyadic point $m/2^n$. It is defined inductively, by
$geod (n+1) (2m) = geod n m$, and $geod (n+1) (2m+1)$ is a middle of $geod n m$ and $geod n (m+1)$.
This is not a completely classical inductive definition, so one has to use \verb+function+ to define
it. Then, one checks inductively that it has all the properties we want, and use it to define the
geodesic segment on dyadic points. We will not use a canonical
representative for a dyadic point, but any representative (i.e., numerator and denominator
will not have to be coprime) -- this will not create problems as $geod$ does not depend on the choice
of the representative, by construction.›
locale complete_space_with_middle =
fixes x0 y0::"'a::complete_space"
assumes middles: "⋀x y::'a. ∃z. dist x z = (dist x y)/2 ∧ dist z y = (dist x y)/2"
begin
definition middle::"'a ⇒ 'a ⇒ 'a"
where "middle x y = (SOME z. dist x z = (dist x y)/2 ∧ dist z y = (dist x y)/2)"
lemma middle:
"dist x (middle x y) = (dist x y)/2"
"dist (middle x y) y = (dist x y)/2"
unfolding middle_def using middles[of x y] by (metis (mono_tags, lifting) someI_ex)+
function geod::"nat ⇒ nat ⇒ 'a" where
"geod 0 0 = x0"
|"geod 0 (Suc m) = y0"
|"geod (Suc n) (2 * m) = geod n m"
|"geod (Suc n) (Suc (2*m)) = middle (geod n m) (geod n (Suc m))"
apply (auto simp add: double_not_eq_Suc_double)
by (metis One_nat_def dvd_mult_div_cancel list_decode.cases odd_Suc_minus_one odd_two_times_div_two_nat)
termination by lexicographic_order
text ‹By induction, the distance between successive points is $D/2^n$.›
lemma geod_distance_successor:
"∀a < 2^n. dist (geod n a) (geod n (Suc a)) = dist x0 y0 / 2^n"
proof (induction n)
case 0
show ?case by auto
next
case (Suc n)
show ?case
proof (auto)
fix a::nat assume a: "a < 2 * 2^n"
obtain m where m: "a = 2 * m ∨ a = Suc (2 * m)" by (metis geod.elims)
then have "m < 2^n" using a by auto
consider "a = 2 * m" | "a = Suc(2*m)" using m by auto
then show "dist (geod (Suc n) a) (geod (Suc n) (Suc a)) = dist x0 y0 / (2 * 2 ^ n)"
proof (cases)
case 1
show ?thesis
unfolding 1 apply auto
unfolding middle using Suc.IH ‹m < 2^n› by auto
next
case 2
have *: "Suc (Suc (2 * m)) = 2 * (Suc m)" by auto
show ?thesis
unfolding 2 apply auto
unfolding * geod.simps(3) middle using Suc.IH ‹m < 2^n› by auto
qed
qed
qed
lemma geod_mult:
"geod n a = geod (n + k) (a * 2^k)"
apply (induction k, auto) using geod.simps(3) by (metis mult.left_commute)
lemma geod_0:
"geod n 0 = x0"
by (induction n, auto, metis geod.simps(3) semiring_normalization_rules(10))
lemma geod_end:
"geod n (2^n) = y0"
by (induction n, auto)
text ‹By the triangular inequality, the distance between points separated by $(b-a)/2^n$ is at
most $D * (b-a)/2^n$.›
lemma geod_upper:
assumes "a ≤ b" "b ≤ 2^n"
shows "dist (geod n a) (geod n b) ≤ (b-a) * dist x0 y0 / 2^n"
proof -
have *: "a+k > 2^n ∨ dist (geod n a) (geod n (a+k)) ≤ k * dist x0 y0 / 2^n" for k
proof (induction k)
case 0 then show ?case by auto
next
case (Suc k)
show ?case
proof (cases "2 ^ n < a + Suc k")
case True then show ?thesis by auto
next
case False
then have *: "a + k < 2 ^ n" by auto
have "dist (geod n a) (geod n (a + Suc k)) ≤ dist (geod n a) (geod n (a+k)) + dist (geod n (a+k)) (geod n (a+Suc k))"
using dist_triangle by auto
also have "... ≤ k * dist x0 y0 / 2^n + dist x0 y0 / 2^n"
using Suc.IH * geod_distance_successor by auto
finally show ?thesis
by (simp add: add_divide_distrib distrib_left mult.commute)
qed
qed
show ?thesis using *[of "b-a"] assms by (simp add: of_nat_diff)
qed
text ‹In fact, the distance is exactly $D * (b-a)/2^n$, otherwise the extremities of the interval
would be closer than $D$, a contradiction.›
lemma geod_dist:
assumes "a ≤ b" "b ≤ 2^n"
shows "dist (geod n a) (geod n b) = (b-a) * dist x0 y0 / 2^n"
proof -
have "dist (geod n a) (geod n b) ≤ (real b-a) * dist x0 y0 / 2^n"
using geod_upper[of a b n] assms by auto
moreover have "¬ (dist (geod n a) (geod n b) < (real b-a) * dist x0 y0 / 2^n)"
proof (rule ccontr, simp)
assume *: "dist (geod n a) (geod n b) < (real b-a) * dist x0 y0 / 2^n"
have "dist x0 y0 = dist (geod n 0) (geod n (2^n))"
using geod_0 geod_end by auto
also have "... ≤ dist (geod n 0) (geod n a) + dist (geod n a) (geod n b) + dist (geod n b) (geod n (2^n))"
using dist_triangle4 by auto
also have "... < a * dist x0 y0 / 2^n + (real b-a) * dist x0 y0 / 2^n + (2^n - real b) * dist x0 y0 / 2^n"
using * assms geod_upper[of 0 a n] geod_upper[of b "2^n" n] by (auto intro: mono_intros)
also have "... = dist x0 y0"
using assms by (auto simp add: algebra_simps divide_simps)
finally show "False" by auto
qed
ultimately show ?thesis by auto
qed
text ‹We deduce the same statement but for points that are not on the same level, by putting
them on a common multiple level.›
lemma geod_dist2:
assumes "a ≤ 2^n" "b ≤ 2^p" "a/2^n ≤ b / 2^p"
shows "dist (geod n a) (geod p b) = (b/2^p - a/2^n) * dist x0 y0"
proof -
define r where "r = max n p"
define ar where "ar = a * 2^(r - n)"
have a: "ar / 2^r = a / 2^n"
unfolding ar_def r_def by (auto simp add: divide_simps semiring_normalization_rules(26))
have A: "geod r ar = geod n a"
unfolding ar_def r_def using geod_mult[of n a "max n p - n"] by auto
define br where "br = b * 2^(r - p)"
have b: "br / 2^r = b / 2^p"
unfolding br_def r_def by (auto simp add: divide_simps semiring_normalization_rules(26))
have B: "geod r br = geod p b"
unfolding br_def r_def using geod_mult[of p b "max n p - p"] by auto
have "dist (geod n a) (geod p b) = dist (geod r ar) (geod r br)"
using A B by auto
also have "... = (real br - ar) * dist x0 y0 / 2 ^r"
apply (rule geod_dist)
using ‹a/2^n ≤ b / 2^p› unfolding a[symmetric] b[symmetric] apply (auto simp add: divide_simps)
using ‹b ≤ 2^p› b apply (auto simp add: divide_simps)
by (metis br_def le_add_diff_inverse2 max.cobounded2 mult.commute mult_le_mono2 r_def semiring_normalization_rules(26))
also have "... = (real br / 2^r - real ar / 2^r) * dist x0 y0"
by (auto simp add: algebra_simps divide_simps)
finally show ?thesis using a b by auto
qed
text ‹Same thing but without a priori ordering of the points.›
lemma geod_dist3:
assumes "a ≤ 2^n" "b ≤ 2^p"
shows "dist (geod n a) (geod p b) = abs(b/2^p - a/2^n) * dist x0 y0"
apply (cases "a /2^n ≤ b/2^p", auto)
apply (rule geod_dist2[OF assms], auto)
apply (subst dist_commute, rule geod_dist2[OF assms(2) assms(1)], auto)
done
text ‹Finally, we define a geodesic by extending what we have already defined on dyadic points,
thanks to the result of isometric extension of isometries taking their values
in complete spaces.›
lemma geod:
shows "∃g. isometry_on {0..dist x0 y0} g ∧ g 0 = x0 ∧ g (dist x0 y0) = y0"
proof (cases "x0 = y0")
case True
show ?thesis apply (rule exI[of _ "λ_. x0"]) unfolding isometry_on_def using True by auto
next
case False
define A where "A = {(real k/2^n) * dist x0 y0 |k n. k ≤ 2^n}"
have "{0..dist x0 y0} ⊆ closure A"
proof (auto simp add: closure_approachable dist_real_def)
fix t::real assume t: "0 ≤ t" "t ≤ dist x0 y0"
fix e:: real assume "e > 0"
then obtain n::nat where n: "dist x0 y0/e < 2^n"
using one_less_numeral_iff real_arch_pow semiring_norm(76) by blast
define k where "k = floor (2^n * t/ dist x0 y0)"
have "k ≤ 2^n * t/ dist x0 y0" unfolding k_def by auto
also have "... ≤ 2^n" using t False by (auto simp add: algebra_simps divide_simps)
finally have "k ≤ 2^n" by auto
have "k ≥ 0" using t False unfolding k_def by auto
define l where "l = nat k"
have "k = int l" "l ≤ 2^n" using ‹k ≥ 0› ‹k ≤ 2^n› nat_le_iff unfolding l_def by auto
have "abs (2^n * t/dist x0 y0 - k) ≤ 1" unfolding k_def by linarith
then have "abs(t - k/2^n * dist x0 y0) ≤ dist x0 y0 / 2^n"
by (auto simp add: algebra_simps divide_simps False)
also have "... < e" using n ‹e > 0› by (auto simp add: algebra_simps divide_simps)
finally have "abs(t - k/2^n * dist x0 y0) < e" by auto
then have "abs(t - l/2^n * dist x0 y0) < e" using ‹k = int l› by auto
moreover have "l/2^n * dist x0 y0 ∈ A" unfolding A_def using ‹l ≤ 2^n› by auto
ultimately show "∃u∈A. abs(u - t) < e" by force
qed
text ‹For each dyadic point, we choose one representation of the form $K/2^N$, it is not important
for us that it is the minimal one.›
define index where "index = (λt. SOME i. t = real (fst i)/2^(snd i) * dist x0 y0 ∧ (fst i) ≤ 2^(snd i))"
define K where "K = (λt. fst (index t))"
define N where "N = (λt. snd (index t))"
have t: "t = K t/ 2^(N t) * dist x0 y0 ∧ K t ≤ 2^(N t)" if "t ∈ A" for t
proof -
obtain n k::nat where "t = k/2^n * dist x0 y0" "k ≤ 2^n" using ‹t∈ A› unfolding A_def by auto
then have *: "∃i. t = real (fst i)/2^(snd i) * dist x0 y0 ∧ (fst i) ≤ 2^(snd i)" by auto
show ?thesis unfolding K_def N_def index_def using someI_ex[OF *] by auto
qed
text ‹We can now define our function on dyadic points.›
define f where "f = (λt. geod (N t) (K t))"
have "0 ∈ A" unfolding A_def by auto
have "f 0 = x0"
proof -
have "0 = K 0 /2^(N 0) * dist x0 y0" using t ‹0 ∈ A› by auto
then have "K 0 = 0" using False by auto
then show ?thesis unfolding f_def using geod_0 by auto
qed
have "dist x0 y0 = (real 1/2^0) * dist x0 y0" by auto
then have "dist x0 y0 ∈ A" unfolding A_def by force
have "f (dist x0 y0) = y0"
proof -
have "dist x0 y0 = K (dist x0 y0) / 2^(N (dist x0 y0)) * dist x0 y0"
using t ‹dist x0 y0 ∈ A› by auto
then have "K (dist x0 y0) = 2^(N(dist x0 y0))" using False by (auto simp add: divide_simps)
then show ?thesis unfolding f_def using geod_end by auto
qed
text ‹By construction, it is an isometry on dyadic points.›
have "isometry_on A f"
proof (rule isometry_onI)
fix s t assume inA: "s ∈ A" "t ∈ A"
have "dist (f s) (f t) = abs (K t/2^(N t) - K s/2^(N s)) * dist x0 y0"
unfolding f_def apply (rule geod_dist3) using t inA by auto
also have "... = abs(K t/2^(N t) * dist x0 y0 - K s/2^(N s) * dist x0 y0)"
by (auto simp add: abs_mult_pos left_diff_distrib)
also have "... = abs(t - s)"
using t inA by auto
finally show "dist (f s) (f t) = dist s t" unfolding dist_real_def by auto
qed
text ‹We can thus extend it to an isometry on the closure of dyadic points.
It is the desired geodesic.›
then obtain g where g: "isometry_on (closure A) g" "⋀t. t ∈ A ⟹ g t = f t"
using isometry_extend_closure by metis
have "isometry_on {0..dist x0 y0} g"
by (rule isometry_on_subset[OF ‹isometry_on (closure A) g› ‹{0..dist x0 y0} ⊆ closure A›])
moreover have "g 0 = x0"
using g(2)[OF ‹0 ∈ A›] ‹f 0 = x0› by simp
moreover have "g (dist x0 y0) = y0"
using g(2)[OF ‹dist x0 y0 ∈ A›] ‹f (dist x0 y0) = y0› by simp
ultimately show ?thesis by auto
qed
end
text ‹We can now complete the proof that a complete space with middles is in fact geodesic:
all the work has been done in the locale \verb+complete_space_with_middle+, in Lemma~\verb+geod+.›
theorem complete_with_middles_imp_geodesic:
assumes "⋀x y::('a::complete_space). ∃m. dist x m = dist x y /2 ∧ dist m y = dist x y /2"
shows "OFCLASS('a, geodesic_space_class)"
proof (standard, rule geodesic_subsetI)
fix x0 y0::'a
interpret complete_space_with_middle x0 y0
apply standard using assms by auto
have "∃g. g 0 = x0 ∧ g (dist x0 y0) = y0 ∧ isometry_on {0..dist x0 y0} g"
using geod by auto
then show "∃G. geodesic_segment_between G x0 y0 ∧ G ⊆ UNIV"
unfolding geodesic_segment_between_def by auto
qed
section ‹Quasi-isometries›
text ‹A $(\lambda, C)$ quasi-isometry is a function which behaves like an isometry, up to
an additive error $C$ and a multiplicative error $\lambda$. It can be very different from an
isometry on small scales (for instance, the function integer part is a quasi-isometry between
$\mathbb{R}$ and $\mathbb{Z}$), but on large scales it captures many important features of
isometries.
When the space is unbounded, one checks easily that $C \geq 0$ and $\lambda \geq 1$. As this
is the only case of interest (any two bounded sets are quasi-isometric), we incorporate
this requirement in the definition.›
definition quasi_isometry_on::"real ⇒ real ⇒ ('a::metric_space) set ⇒ ('a ⇒ ('b::metric_space)) ⇒ bool"
("_ _ -quasi'_isometry'_on" [1000, 999])
where "lambda C-quasi_isometry_on X f = ((lambda ≥ 1) ∧ (C ≥ 0) ∧
(∀x ∈ X. ∀y ∈ X. (dist (f x) (f y) ≤ lambda * dist x y + C ∧ dist (f x) (f y) ≥ (1/lambda) * dist x y - C)))"
abbreviation quasi_isometry :: "real ⇒ real ⇒ ('a::metric_space ⇒ 'b::metric_space) ⇒ bool"
("_ _ -quasi'_isometry" [1000, 999])
where "quasi_isometry lambda C f ≡ lambda C-quasi_isometry_on UNIV f"
subsection ‹Basic properties of quasi-isometries›
lemma quasi_isometry_onD:
assumes "lambda C-quasi_isometry_on X f"
shows "⋀x y. x ∈ X ⟹ y ∈ X ⟹ dist (f x) (f y) ≤ lambda * dist x y + C"
"⋀x y. x ∈ X ⟹ y ∈ X ⟹ dist (f x) (f y) ≥ (1/lambda) * dist x y - C"
"lambda ≥ 1" "C ≥ 0"
using assms unfolding quasi_isometry_on_def by auto
lemma quasi_isometry_onI [intro]:
assumes "⋀x y. x ∈ X ⟹ y ∈ X ⟹ dist (f x) (f y) ≤ lambda * dist x y + C"
"⋀x y. x ∈ X ⟹ y ∈ X ⟹ dist (f x) (f y) ≥ (1/lambda) * dist x y - C"
"lambda ≥ 1" "C ≥ 0"
shows "lambda C-quasi_isometry_on X f"
using assms unfolding quasi_isometry_on_def by auto
lemma isometry_quasi_isometry_on:
assumes "isometry_on X f"
shows "1 0-quasi_isometry_on X f"
using assms unfolding isometry_on_def quasi_isometry_on_def by auto
lemma quasi_isometry_on_change_params:
assumes "lambda C-quasi_isometry_on X f" "mu ≥ lambda" "D ≥ C"
shows "mu D-quasi_isometry_on X f"
proof (rule quasi_isometry_onI)
have P1: "lambda ≥ 1" "C ≥ 0" using quasi_isometry_onD[OF assms(1)] by auto
then show P2: "mu ≥ 1" "D ≥ 0" using assms by auto
fix x y assume inX: "x ∈ X" "y ∈ X"
have "dist (f x) (f y) ≤ lambda * dist x y + C"
using quasi_isometry_onD[OF assms(1)] inX by auto
also have "... ≤ mu * dist x y + D"
using assms by (auto intro!: mono_intros)
finally show "dist (f x) (f y) ≤ mu * dist x y + D" by simp
have "dist (f x) (f y) ≥ (1/lambda) * dist x y - C"
using quasi_isometry_onD[OF assms(1)] inX by auto
moreover have "(1/lambda) * dist x y + (- C) ≥ (1/mu) * dist x y + (- D)"
apply (intro mono_intros)
using P1 P2 assms by (auto simp add: divide_simps)
ultimately show "dist (f x) (f y) ≥ (1/mu) * dist x y - D" by simp
qed
lemma quasi_isometry_on_subset:
assumes "lambda C-quasi_isometry_on X f"
"Y ⊆ X"
shows "lambda C-quasi_isometry_on Y f"
using assms unfolding quasi_isometry_on_def by auto
lemma quasi_isometry_on_perturb:
assumes "lambda C-quasi_isometry_on X f"
"D ≥ 0"
"⋀x. x ∈ X ⟹ dist (f x) (g x) ≤ D"
shows "lambda (C + 2 * D)-quasi_isometry_on X g"
proof (rule quasi_isometry_onI)
show "lambda ≥ 1" "C + 2 * D ≥ 0" using ‹D ≥ 0› quasi_isometry_onD[OF assms(1)] by auto
fix x y assume *: "x ∈ X" "y ∈ X"
have "dist (g x) (g y) ≤ dist (f x) (f y) + 2 * D"
using assms(3)[OF *(1)] assms(3)[OF *(2)] dist_triangle4[of "g x" "g y" "f x" "f y"] by (simp add: dist_commute)
then show "dist (g x) (g y) ≤ lambda * dist x y + (C + 2 * D)"
using quasi_isometry_onD(1)[OF assms(1) *] by auto
have "dist (g x) (g y) ≥ dist (f x) (f y) - 2 * D"
using assms(3)[OF *(1)] assms(3)[OF *(2)] dist_triangle4[of "f x" "f y" "g x" "g y"] by (simp add: dist_commute)
then show "dist (g x) (g y) ≥ (1/lambda) * dist x y - (C + 2 * D)"
using quasi_isometry_onD(2)[OF assms(1) *] by auto
qed
lemma quasi_isometry_on_compose:
assumes "lambda C-quasi_isometry_on X f"
"mu D-quasi_isometry_on Y g"
"f`X ⊆ Y"
shows "(lambda * mu) (C * mu + D)-quasi_isometry_on X (g o f)"
proof (rule quasi_isometry_onI)
have I: "lambda ≥ 1" "C ≥ 0" "mu ≥ 1" "D ≥ 0"
using quasi_isometry_onD[OF assms(1)] quasi_isometry_onD[OF assms(2)] by auto
then show "lambda * mu ≥ 1" "C * mu + D ≥ 0"
by (auto, metis dual_order.order_iff_strict le_numeral_extra(2) mult_le_cancel_right1 order.strict_trans1)
fix x y assume inX: "x ∈ X" "y ∈ X"
then have inY: "f x ∈ Y" "f y ∈ Y" using ‹f`X ⊆ Y› by auto
have "dist ((g o f) x) ((g o f) y) ≤ mu * dist (f x) (f y) + D"
using quasi_isometry_onD(1)[OF assms(2) inY] by simp
also have "... ≤ mu * (lambda * dist x y + C) + D"
using ‹mu ≥ 1› quasi_isometry_onD(1)[OF assms(1) inX] by auto
finally show "dist ((g o f) x) ((g o f) y) ≤ (lambda * mu) * dist x y + (C * mu + D)"
by (auto simp add: algebra_simps)
have "(1/(lambda * mu)) * dist x y - (C * mu + D) ≤ (1/(lambda * mu)) * dist x y - (C/mu + D)"
using ‹mu ≥ 1› ‹C ≥ 0› apply (auto, auto simp add: divide_simps)
by (metis eq_iff less_eq_real_def mult.commute mult_eq_0_iff mult_le_cancel_right1 order.trans)
also have "... = (1/mu) * ((1/lambda) * dist x y - C) - D"
by (auto simp add: algebra_simps)
also have "... ≤ (1/mu) * dist (f x) (f y) - D"
using ‹mu ≥ 1› quasi_isometry_onD(2)[OF assms(1) inX] by (auto simp add: divide_simps)
also have "... ≤ dist ((g o f) x) ((g o f) y)"
using quasi_isometry_onD(2)[OF assms(2) inY] by auto
finally show "1 / (lambda * mu) * dist x y - (C * mu + D) ≤ dist ((g ∘ f) x) ((g ∘ f) y)"
by auto
qed
lemma quasi_isometry_on_bounded:
assumes "lambda C-quasi_isometry_on X f"
"bounded X"
shows "bounded (f`X)"
proof (cases "X = {}")
case True
then show ?thesis by auto
next
case False
obtain x where "x ∈ X" using False by auto
obtain e where e: "⋀z. z ∈ X ⟹ dist x z ≤ e"
using bounded_any_center assms(2) by metis
have "dist (f x) y ≤ C + lambda * e" if "y ∈ f`X" for y
proof -
obtain z where *: "z ∈ X" "y = f z" using ‹y ∈ f`X› by auto
have "dist (f x) y ≤ lambda * dist x z + C"
unfolding ‹y = f z› using * quasi_isometry_onD(1)[OF assms(1) ‹x ∈ X› ‹z ∈ X›] by (auto simp add: add_mono)
also have "... ≤ C + lambda * e" using e[OF ‹z ∈ X›] quasi_isometry_onD(3)[OF assms(1)] by auto
finally show ?thesis by simp
qed
then show ?thesis unfolding bounded_def by auto
qed
lemma quasi_isometry_on_empty:
assumes "C ≥ 0" "lambda ≥ 1"
shows "lambda C-quasi_isometry_on {} f"
using assms unfolding quasi_isometry_on_def by auto
text ‹Quasi-isometries change the distance to a set by at most $\lambda \cdot + C$, this follows
readily from the fact that this inequality holds pointwise.›
lemma quasi_isometry_on_infdist:
assumes "lambda C-quasi_isometry_on X f"
"w ∈ X"
"S ⊆ X"
shows "infdist (f w) (f`S) ≤ lambda * infdist w S + C"
"infdist (f w) (f`S) ≥ (1/lambda) * infdist w S - C"
proof -
have "lambda ≥ 1" "C ≥ 0" using quasi_isometry_onD[OF assms(1)] by auto
show "infdist (f w) (f`S) ≤ lambda * infdist w S + C"
proof (cases "S = {}")
case True
then show ?thesis
using ‹C ≥ 0› unfolding infdist_def by auto
next
case False
then have "(INF x∈S. dist (f w) (f x)) ≤ (INF x∈S. lambda * dist w x + C)"
apply (rule cINF_superset_mono)
apply (meson bdd_belowI2 zero_le_dist) using assms by (auto intro!: quasi_isometry_onD(1)[OF assms(1)])
also have "... = (INF t∈(dist w)`S. lambda * t + C)"
by (auto simp add: image_comp)
also have "... = lambda * Inf ((dist w)`S) + C"
apply (rule continuous_at_Inf_mono[symmetric])
unfolding mono_def using ‹lambda ≥ 1› False by (auto intro!: continuous_intros)
finally show ?thesis unfolding infdist_def using False by (auto simp add: image_comp)
qed
show "1 / lambda * infdist w S - C ≤ infdist (f w) (f ` S)"
proof (cases "S = {}")
case True
then show ?thesis
using ‹C ≥ 0› unfolding infdist_def by auto
next
case False
then have "(1/lambda) * infdist w S - C = (1/lambda) * Inf ((dist w)`S) - C"
unfolding infdist_def by auto
also have "... = (INF t∈(dist w)`S. (1/lambda) * t - C)"
apply (rule continuous_at_Inf_mono)
unfolding mono_def using ‹lambda ≥ 1› False by (auto simp add: divide_simps intro!: continuous_intros)
also have "... = (INF x∈S. (1/lambda) * dist w x - C)"
by (auto simp add: image_comp)
also have "... ≤ (INF x∈S. dist (f w) (f x))"
apply (rule cINF_superset_mono[OF False]) apply (rule bdd_belowI2[of _ "-C"])
using assms ‹lambda ≥ 1› apply simp apply simp apply (rule quasi_isometry_onD(2)[OF assms(1)])
using assms by auto
finally show ?thesis unfolding infdist_def using False by (auto simp add: image_comp)
qed
qed
subsection ‹Quasi-isometric isomorphisms›
text ‹The notion of isomorphism for quasi-isometries is not that it should be a bijection, as it is
a coarse notion, but that it is a bijection up to a bounded displacement. For instance, the
inclusion of $\mathbb{Z}$ in $\mathbb{R}$ is a quasi-isometric isomorphism between these spaces,
whose (quasi)-inverse (which is non-unique) is given by the function integer part. This is
formalized in the next definition.›
definition quasi_isometry_between::"real ⇒ real ⇒ ('a::metric_space) set ⇒ ('b::metric_space) set ⇒ ('a ⇒ 'b) ⇒ bool"
("_ _ -quasi'_isometry'_between" [1000, 999])
where "lambda C-quasi_isometry_between X Y f = ((lambda C-quasi_isometry_on X f) ∧ (f`X ⊆ Y) ∧ (∀y∈Y. ∃x∈X. dist (f x) y ≤ C))"
definition quasi_isometric::"('a::metric_space) set ⇒ ('b::metric_space) set ⇒ bool"
where "quasi_isometric X Y = (∃lambda C f. lambda C-quasi_isometry_between X Y f)"
lemma quasi_isometry_betweenD:
assumes "lambda C-quasi_isometry_between X Y f"
shows "lambda C-quasi_isometry_on X f"
"f`X ⊆ Y"
"⋀y. y ∈ Y ⟹ ∃x∈X. dist (f x) y ≤ C"
"⋀x y. x ∈ X ⟹ y ∈ X ⟹ dist (f x) (f y) ≤ lambda * dist x y + C"
"⋀x y. x ∈ X ⟹ y ∈ X ⟹ dist (f x) (f y) ≥ (1/lambda) * dist x y - C"
"lambda ≥ 1" "C ≥ 0"
using assms unfolding quasi_isometry_between_def quasi_isometry_on_def by auto
lemma quasi_isometry_betweenI:
assumes "lambda C-quasi_isometry_on X f"
"f`X ⊆ Y"
"⋀y. y ∈ Y ⟹ ∃x∈X. dist (f x) y ≤ C"
shows "lambda C-quasi_isometry_between X Y f"
using assms unfolding quasi_isometry_between_def by auto
lemma quasi_isometry_on_between:
assumes "lambda C-quasi_isometry_on X f"
shows "lambda C-quasi_isometry_between X (f`X) f"
using assms unfolding quasi_isometry_between_def quasi_isometry_on_def by force
lemma quasi_isometry_between_change_params:
assumes "lambda C-quasi_isometry_between X Y f" "mu ≥ lambda" "D ≥ C"
shows "mu D-quasi_isometry_between X Y f"
proof (rule quasi_isometry_betweenI)
show "mu D-quasi_isometry_on X f"
by (rule quasi_isometry_on_change_params[OF quasi_isometry_betweenD(1)[OF assms(1)] assms(2) assms(3)])
show "f`X ⊆ Y" using quasi_isometry_betweenD[OF assms(1)] by auto
fix y assume "y ∈ Y"
show "∃x∈X. dist (f x) y ≤ D" using quasi_isometry_betweenD(3)[OF assms(1) ‹y ∈ Y›] ‹D ≥ C› by force
qed
lemma quasi_isometry_subset:
assumes "X ⊆ Y" "⋀y. y ∈ Y ⟹ ∃x∈X. dist x y ≤ C" "C ≥ 0"
shows "1 C-quasi_isometry_between X Y (λx. x)"
unfolding quasi_isometry_between_def using assms by auto
lemma isometry_quasi_isometry_between:
assumes "isometry f"
shows "1 0-quasi_isometry_between UNIV UNIV f"
using assms unfolding quasi_isometry_between_def quasi_isometry_on_def isometry_def isometry_on_def surj_def by (auto) metis
proposition quasi_isometry_inverse:
assumes "lambda C-quasi_isometry_between X Y f"
shows "∃g. lambda (3 * C * lambda)-quasi_isometry_between Y X g
∧ (∀x∈X. dist x (g (f x)) ≤ 3 * C * lambda)
∧ (∀y∈Y. dist y (f (g y)) ≤ 3 * C * lambda)"
proof -
define g where "g = (λy. SOME x. x ∈ X ∧ dist (f x) y ≤ C)"
have *: "g y ∈ X ∧ dist (f (g y)) y ≤ C" if "y ∈ Y" for y
unfolding g_def using quasi_isometry_betweenD(3)[OF assms that] by (metis (no_types, lifting) someI_ex)
have "lambda ≥ 1" "C ≥ 0" using quasi_isometry_betweenD[OF assms] by auto
have "C ≤ 3 * C * lambda" using ‹lambda ≥ 1› ‹C ≥ 0›
by (simp add: algebra_simps mult_ge1_mono)
then have A: "dist y (f (g y)) ≤ 3 * C * lambda" if "y ∈ Y" for y
using *[OF that] by (simp add: dist_commute)
have B: "dist x (g (f x)) ≤ 3 * C * lambda" if "x ∈ X" for x
proof -
have "f x ∈ Y" using that quasi_isometry_betweenD(2)[OF assms] by auto
have "(1/lambda) * dist x (g (f x)) - C ≤ dist (f x) (f (g (f x)))"
apply (rule quasi_isometry_betweenD(5)[OF assms]) using that *[OF ‹f x ∈ Y›] by auto
also have "... ≤ C" using *[OF ‹f x ∈ Y›] by (simp add: dist_commute)
finally have "dist x (g (f x)) ≤ 2 * C * lambda"
using ‹lambda ≥ 1› ‹C ≥ 0› by (simp add: divide_simps)
also have "... ≤ 3 * C * lambda"
using ‹lambda ≥ 1› ‹C ≥ 0› by (simp add: divide_simps)
finally show ?thesis by auto
qed
have "lambda (3 * C * lambda)-quasi_isometry_on Y g"
proof (rule quasi_isometry_onI)
show "lambda ≥ 1" "3 * C * lambda ≥ 0" using ‹lambda ≥ 1› ‹C ≥ 0› by auto
fix y1 y2 assume inY: "y1 ∈ Y" "y2 ∈ Y"
then have inX: "g y1 ∈ X" "g y2 ∈ X" using * by auto
have "dist y1 y2 ≤ dist y1 (f (g y1)) + dist (f (g y1)) (f (g y2)) + dist (f (g y2)) y2"
using dist_triangle4 by auto
also have "... ≤ C + dist (f (g y1)) (f (g y2)) + C"
using *[OF inY(1)] *[OF inY(2)] by (auto simp add: dist_commute intro: add_mono)
also have "... ≤ C + (lambda * dist (g y1) (g y2) + C) + C"
using quasi_isometry_betweenD(4)[OF assms inX] by (auto intro: add_mono)
finally have "dist y1 y2 - 3 * C ≤ lambda * dist (g y1) (g y2)" by auto
then have "dist (g y1) (g y2) ≥ (1/lambda) * dist y1 y2 - 3 * C / lambda"
using ‹lambda ≥ 1› by (auto simp add: divide_simps mult.commute)
moreover have "3 * C / lambda ≤ 3 * C * lambda"
using ‹lambda ≥ 1› ‹C ≥ 0› apply (auto simp add: divide_simps mult_le_cancel_left1)
by (metis dual_order.order_iff_strict less_1_mult mult.left_neutral)
ultimately show "dist (g y1) (g y2) ≥ (1/lambda) * dist y1 y2 - 3 * C * lambda"
by auto
have "(1/lambda) * dist (g y1) (g y2) - C ≤ dist (f (g y1)) (f (g y2))"
using quasi_isometry_betweenD(5)[OF assms inX] by auto
also have "... ≤ dist (f (g y1)) y1 + dist y1 y2 + dist y2 (f (g y2))"
using dist_triangle4 by auto
also have "... ≤ C + dist y1 y2 + C"
using *[OF inY(1)] *[OF inY(2)] by (auto simp add: dist_commute intro: add_mono)
finally show "dist (g y1) (g y2) ≤ lambda * dist y1 y2 + 3 * C * lambda"
using ‹lambda ≥ 1› by (auto simp add: divide_simps algebra_simps)
qed
then have "lambda (3 * C * lambda)-quasi_isometry_between Y X g"
proof (rule quasi_isometry_betweenI)
show "g ` Y ⊆ X" using * by auto
fix x assume "x ∈ X"
have "f x ∈ Y" "dist (g (f x)) x ≤ 3 * C * lambda"
using B[OF ‹x ∈ X›] quasi_isometry_betweenD(2)[OF assms] ‹x ∈ X› by (auto simp add: dist_commute)
then show "∃y∈Y. dist (g y) x ≤ 3 * C * lambda" by blast
qed
then show ?thesis using A B by blast
qed
proposition quasi_isometry_compose:
assumes "lambda C-quasi_isometry_between X Y f"
"mu D-quasi_isometry_between Y Z g"
shows "(lambda * mu) (C * mu + 2 * D)-quasi_isometry_between X Z (g o f)"
proof (rule quasi_isometry_betweenI)
have "(lambda * mu) (C * mu + D)-quasi_isometry_on X (g ∘ f)"
by (rule quasi_isometry_on_compose[OF quasi_isometry_betweenD(1)[OF assms(1)]
quasi_isometry_betweenD(1)[OF assms(2)] quasi_isometry_betweenD(2)[OF assms(1)]])
then show "(lambda * mu) (C * mu + 2 * D)-quasi_isometry_on X (g ∘ f)"
apply (rule quasi_isometry_on_change_params) using quasi_isometry_betweenD(7)[OF assms(2)] by auto
show "(g ∘ f) ` X ⊆ Z"
using quasi_isometry_betweenD(2)[OF assms(1)] quasi_isometry_betweenD(2)[OF assms(2)]
by auto
fix z assume "z ∈ Z"
obtain y where y: "y ∈ Y" "dist (g y) z ≤ D"
using quasi_isometry_betweenD(3)[OF assms(2) ‹z ∈ Z›] by auto
obtain x where x: "x ∈ X" "dist (f x) y ≤ C"
using quasi_isometry_betweenD(3)[OF assms(1) ‹y ∈ Y›] by auto
have "dist ((g o f) x) z ≤ dist (g (f x)) (g y) + dist (g y) z"
using dist_triangle by auto
also have "... ≤ (mu * dist (f x) y + D) + D"
apply (rule add_mono, rule quasi_isometry_betweenD(4)[OF assms(2)])
using x y quasi_isometry_betweenD(2)[OF assms(1)] by auto
also have "... ≤ C * mu + 2 * D"
using x(2) quasi_isometry_betweenD(6)[OF assms(2)] by auto
finally show "∃x∈X. dist ((g ∘ f) x) z ≤ C * mu + 2 * D"
using x(1) by auto
qed
theorem quasi_isometric_equiv_rel:
"quasi_isometric X X"
"quasi_isometric X Y ⟹ quasi_isometric Y Z ⟹ quasi_isometric X Z"
"quasi_isometric X Y ⟹ quasi_isometric Y X"
proof -
show "quasi_isometric X X"
unfolding quasi_isometric_def using quasi_isometry_subset[of X X 0] by auto
assume H: "quasi_isometric X Y"
then show "quasi_isometric Y X"
unfolding quasi_isometric_def using quasi_isometry_inverse by blast
assume "quasi_isometric Y Z"
then show "quasi_isometric X Z"
using H unfolding quasi_isometric_def using quasi_isometry_compose by blast
qed
text ‹Many interesting properties in geometric group theory are invariant under quasi-isometry.
We prove the most basic ones here.›
lemma quasi_isometric_empty:
assumes "X = {}" "quasi_isometric X Y"
shows "Y = {}"
using assms unfolding quasi_isometric_def quasi_isometry_between_def quasi_isometry_on_def by blast
lemma quasi_isometric_bounded:
assumes "bounded X" "quasi_isometric X Y"
shows "bounded Y"
proof (cases "X = {}")
case True
show ?thesis using quasi_isometric_empty[OF True assms(2)] by auto
next
case False
obtain lambda C f where QI: "lambda C-quasi_isometry_between X Y f"
using assms(2) unfolding quasi_isometric_def by auto
obtain x where "x ∈ X" using False by auto
obtain e where e: "⋀z. z ∈ X ⟹ dist x z ≤ e"
using bounded_any_center assms(1) by metis
have "dist (f x) y ≤ 2 * C + lambda * e" if "y ∈ Y" for y
proof -
obtain z where *: "z ∈ X" "dist (f z) y ≤ C"
using quasi_isometry_betweenD(3)[OF QI ‹y ∈ Y›] by auto
have "dist (f x) y ≤ dist (f x) (f z) + dist (f z) y" using dist_triangle by auto
also have "... ≤ (lambda * dist x z + C) + C"
using * quasi_isometry_betweenD(4)[OF QI ‹x ∈ X› ‹z ∈ X›] by (auto simp add: add_mono)
also have "... ≤ 2 * C + lambda * e"
using quasi_isometry_betweenD(6)[OF QI] e[OF ‹z ∈ X›] by (auto simp add: algebra_simps)
finally show ?thesis by simp
qed
then show ?thesis unfolding bounded_def by auto
qed
lemma quasi_isometric_bounded_iff:
assumes "bounded X" "X ≠ {}" "bounded Y" "Y ≠ {}"
shows "quasi_isometric X Y"
proof -
obtain x y where "x ∈ X" "y ∈ Y" using assms by auto
obtain C where C: "⋀z. z ∈ Y ⟹ dist y z ≤ C"
using ‹bounded Y› bounded_any_center by metis
have "C ≥ 0" using C[OF ‹y ∈ Y›] by auto
obtain D where D: "⋀z. z ∈ X ⟹ dist x z ≤ D"
using ‹bounded X› bounded_any_center by metis
have "D ≥ 0" using D[OF ‹x ∈ X›] by auto
define f::"'a ⇒ 'b" where "f = (λ_. y)"
have "1 (C + 2 * D)-quasi_isometry_between X Y f"
proof (rule quasi_isometry_betweenI)
show "f`X ⊆ Y" unfolding f_def using ‹y ∈ Y› by auto
show "1 (C + 2 * D)-quasi_isometry_on X f"
proof (rule quasi_isometry_onI, auto simp add: ‹C ≥ 0› ‹D ≥ 0› f_def)
fix a b assume "a ∈ X" "b ∈ X"
have "dist a b ≤ dist a x + dist x b"
using dist_triangle by auto
also have "... ≤ D + D"
using D[OF ‹a ∈ X›] D[OF ‹b ∈ X›] by (auto simp add: dist_commute)
finally show "dist a b ≤ C + 2 * D" using ‹C ≥ 0› by auto
qed
show "∃a∈X. dist (f a) z ≤ C + 2 * D" if "z ∈ Y" for z
unfolding f_def using ‹x ∈ X› C[OF ‹z ∈ Y›] ‹D ≥ 0› by auto
qed
then show ?thesis unfolding quasi_isometric_def by auto
qed
subsection ‹Quasi-isometries of Euclidean spaces.›
text ‹A less trivial fact is that the dimension of euclidean spaces is invariant under
quasi-isometries. It is proved below using growth argument, as quasi-isometries preserve the
growth rate.
The growth of the space is asymptotic behavior of the number of well-separated points that
fit in a ball of radius $R$, when $R$ tends to infinity. Up to a suitable equivalence, it is
clearly a quasi-isometry invariance. We show below that, in a Euclidean space of dimension $d$,
the growth is like $R^d$: the upper bound is obtained by using the fact that we have disjoint balls
inside a big ball, hence volume controls conclude the argument, while the lower bound is obtained
by considering integer points.›
text ‹First, we show that the growth rate of a Euclidean space of dimension $d$ is bounded
from above by $R^d$, using the control on measure of disjoint balls and a volume argument.›
proposition growth_rate_euclidean_above:
fixes D::real
assumes "D > (0::real)"
and H: "F ⊆ cball (0::'a::euclidean_space) R" "R ≥ 0"
"⋀x y. x ∈ F ⟹ y ∈ F ⟹ x ≠ y ⟹ dist x y ≥ D"
shows "finite F ∧ card F ≤ 1 + ((6/D)^(DIM('a))) * R^(DIM('a))"
proof -
define C::real where "C = ((6/D)^(DIM('a)))"
have "C ≥ 0" unfolding C_def using ‹D > 0› by auto
have "D/3 ≥ 0" using assms by auto
have "finite F ∧ card F ≤ 1 + C * R^(DIM('a))"
proof (cases "R < D/2")
case True
have "x = y" if "x ∈ F" "y ∈ F" for x y
proof (rule ccontr)
assume "¬(x = y)"
then have "D ≤ dist x y" using H ‹x ∈ F› ‹y ∈ F› by auto
also have "... ≤ dist x 0 + dist 0 y" by (rule dist_triangle)
also have "... ≤ R + R"
using H(1) ‹x ∈ F› ‹y ∈ F› by (intro add_mono, auto)
also have "... < D" using ‹R < D/2› by auto
finally show False by simp
qed
then have "finite F ∧ card F ≤ 1" using finite_at_most_singleton by auto
moreover have "1 + 0 * R^(DIM('a)) ≤ 1 + C * R^(DIM('a))"
using ‹C ≥ 0› ‹R ≥ 0› by (auto intro: mono_intros)
ultimately show ?thesis by auto
next
case False
have "card G ≤ 1 + C * R^(DIM('a))" if "G ⊆ F" "finite G" for G
proof -
have "norm y ≤ 2*R" if "y ∈ cball x (D/3)" "x ∈ G" for x y
proof -
have "norm y = dist 0 y" by auto
also have "... ≤ dist 0 x + dist x y" by (rule dist_triangle)
also have "... ≤ R + D/3"
using ‹x ∈ G› ‹G ⊆ F› ‹y ∈ cball x (D/3)› ‹F ⊆ cball 0 R› by (auto intro: add_mono)
finally show ?thesis using False ‹D > 0› by auto
qed
then have I: "(⋃x∈G. cball x (D/3)) ⊆ cball 0 (2*R)"
by auto
have "disjoint_family_on (λx. cball x (D/3)) G"
unfolding disjoint_family_on_def proof (auto)
fix a b x assume *: "a ∈ G" "b ∈ G" "a ≠ b" "dist a x * 3 ≤ D" "dist b x * 3 ≤ D"
then have "D ≤ dist a b" using H ‹G ⊆ F› by auto
also have "... ≤ dist a x + dist x b" by (rule dist_triangle)
also have "... ≤ D/3 + D/3"
using * by (auto simp add: dist_commute intro: mono_intros)
also have "... < D" using ‹D > 0› by auto
finally show False by simp
qed
have "2 * R ≥ 0" using ‹R ≥ 0› by auto
define A where "A = measure lborel (cball (0::'a) 1)"
have "A > 0" unfolding A_def using lebesgue_measure_ball_pos by auto
have "card G * ((D/3)^(DIM('a)) * A) = (∑x∈G. ((D/3)^(DIM('a)) * A))"
by auto
also have "... = (∑x∈G. measure lborel (cball x (D/3)))"
unfolding lebesgue_measure_ball[OF ‹D/3 ≥ 0›] A_def by auto
also have "... = measure lborel (⋃x∈G. cball x (D/3))"
apply (rule measure_finite_Union[symmetric, OF ‹finite G› _ ‹disjoint_family_on (λx. cball x (D/3)) G›])
apply auto using emeasure_bounded_finite less_imp_neq by auto
also have "... ≤ measure lborel (cball (0::'a) (2*R))"
apply (rule measure_mono_fmeasurable) using I ‹finite G› emeasure_bounded_finite
unfolding fmeasurable_def by auto
also have "... = (2*R)^(DIM('a)) * A"
unfolding A_def using lebesgue_measure_ball[OF ‹2*R ≥ 0›] by auto
finally have "card G * (D/3)^(DIM('a)) ≤ (2*R)^(DIM('a))"
using ‹A > 0› by (auto simp add: divide_simps)
then have "card G ≤ C * R^(DIM('a))"
unfolding C_def using ‹D > 0› apply (auto simp add: algebra_simps divide_simps)
by (metis numeral_times_numeral power_mult_distrib semiring_norm(12) semiring_norm(14))
then show ?thesis by auto
qed
then show "finite F ∧ card F ≤ 1 + C * R^(DIM('a))"
by (rule finite_finite_subset_caract')
qed
then show ?thesis unfolding C_def by blast
qed
text ‹Then, we show that the growth rate of a Euclidean space of dimension $d$ is bounded
from below by $R^d$, using integer points.›
proposition growth_rate_euclidean_below:
fixes D::real
assumes "R ≥ 0"
shows "∃F. (F ⊆ cball (0::'a::euclidean_space) R
∧ (∀x∈F. ∀y∈F. x = y ∨ dist x y ≥ D) ∧ finite F ∧ card F ≥ (1/((max D 1) * DIM('a)))^(DIM('a)) * R^(DIM('a)))"
proof -
define E where "E = max D 1"
have "E > 0" unfolding E_def by auto
define c where "c = (1/(E * DIM('a)))^(DIM('a))"
have "c > 0" unfolding c_def using ‹E > 0› by auto
define n where "n = nat (floor (R/(E * DIM('a)))) + 1"
then have "n > 0" using ‹R ≥ 0› by auto
have "R/(E * DIM('a)) ≤ n" unfolding n_def by linarith
then have "c * R^(DIM('a)) ≤ n^(DIM('a))"
unfolding c_def power_mult_distrib[symmetric] by (auto simp add: ‹0 < E› ‹0 ≤ R› less_imp_le power_mono)
have "n-1 ≤ R/(E * DIM('a))"
unfolding n_def using ‹R ≥ 0› ‹E > 0› by auto
then have "E * DIM('a) * (n-1) ≤ R"
using ‹R ≥ 0› ‹E > 0› by (simp add: mult.commute pos_le_divide_eq)
text ‹We want to consider the set of linear combinations of basis elements with integer
coefficients bounded by $n$ (multiplied by $E$ to guarantee the $D$ separation).
The formal way to write these elements is to consider all
the functions from the basis to $\{0,\dotsc, n-1\}$, and associate to such a function
$f$ the point $\sum E f(i) \cdot i$ where the sum is over all basis elements $i$. This is
what the next definition does.›
define F::"'a set" where "F = (λf. (∑i∈Basis. (E * real (f i)) *⇩R i))`((Basis::('a set)) →⇩E {0..<n})"
have "f = g" if "f ∈ (Basis::('a set)) →⇩E {0..<n}" "g ∈ Basis →⇩E {0..<n}"
"(∑i∈Basis. (E * real (f i)) *⇩R i) = (∑i∈Basis. (E * real (g i)) *⇩R i)" for f g
proof (rule ext)
fix i show "f i = g i"
proof (cases "i ∈ Basis")
case True
then have "E * real(f i) = E * real(g i)"
using inner_sum_left_Basis[OF True, of "λi. E * real(f i)"] inner_sum_left_Basis[OF True, of "λi. E * real(g i)"] that(3)
by auto
then show "f i = g i" using ‹E > 0› by auto
next
case False
then have "f i = undefined" "g i = undefined" using that by auto
then show "f i = g i" by auto
qed
qed
then have "inj_on (λf. (∑i∈Basis. (E * real (f i)) *⇩R i)) ((Basis::('a set)) →⇩E {0..<n})"
by (simp add: inj_onI)
then have "card F = card ((Basis::('a set)) →⇩E {0..<n})" unfolding F_def
using card_image by blast
also have "... = n^(DIM('a))"
unfolding card_PiE[OF finite_Basis] by (auto simp add: prod_constant)
finally have "card F = n^(DIM('a))" by auto
then have "finite F" using ‹n > 0›
using card.infinite by force
have "card F ≥ c * R^(DIM('a))"
using ‹c * R^(DIM('a)) ≤ n^(DIM('a))› ‹card F = n^(DIM('a))› by auto
have separation: "dist x y ≥ D" if "x ∈ F" "y ∈ F" "x ≠ y" for x y
proof -
obtain f where x: "f ∈ (Basis::('a set)) →⇩E {0..<n}" "x = (∑i∈Basis. (E * real (f i)) *⇩R i)"
using ‹x ∈ F› unfolding F_def by auto
obtain g where y: "g ∈ (Basis::('a set)) →⇩E {0..<n}" "y = (∑i∈Basis. (E * real (g i)) *⇩R i)"
using ‹y ∈ F› unfolding F_def by auto
obtain i where "f i ≠ g i" using x y ‹x ≠y› by force
moreover have "f j = g j" if "j ∉ Basis" for j
using x(1) y(1) that by fastforce
ultimately have "i ∈ Basis" by auto
have "D ≤ E" unfolding E_def by auto
also have "... ≤ abs(E * (real (f i) - real (g i)))" using ‹E > 0›
using ‹f i ≠ g i› by (auto simp add: divide_simps abs_mult)
also have "... = abs(inner x i - inner y i)"
unfolding x(2) y(2) inner_sum_left_Basis[OF ‹i ∈ Basis›] by (auto simp add: algebra_simps)
also have "... = abs(inner (x-y) i)"
by (simp add: inner_diff_left)
also have "... ≤ norm (x-y)" using Basis_le_norm[OF ‹i ∈ Basis›] by blast
finally show "dist x y ≥ D" by (simp add: dist_norm)
qed
have "norm x ≤ R" if "x ∈ F" for x
proof -
obtain f where x: "f ∈ (Basis::('a set)) →⇩E {0..<n}" "x = (∑i∈Basis. (E * real (f i)) *⇩R i)"
using ‹x ∈ F› unfolding F_def by auto
then have "norm x = norm (∑i∈Basis. (E * real (f i)) *⇩R i)" by simp
also have "... ≤ (∑i∈Basis. norm((E * real (f i)) *⇩R i))"
by (rule norm_sum)
also have "... = (∑i∈Basis. abs(E * real (f i)))" by auto
also have "... = (∑i∈Basis. E * real (f i))" using ‹E > 0› by auto
also have "... ≤ (∑i∈(Basis::'a set). E * (n-1))"
apply (rule sum_mono) using PiE_mem[OF x(1)] ‹E > 0› apply (auto simp add: divide_simps)
using ‹n > 0› by fastforce
also have "... = DIM('a) * E * (n-1)"
by auto
finally show "norm x ≤ R" using ‹E * DIM('a) * (n-1) ≤ R› by (auto simp add: algebra_simps)
qed
then have "F ⊆ cball 0 R" by auto
then show ?thesis using ‹card F ≥ c * R^(DIM('a))› ‹finite F› separation c_def E_def by blast
qed
text ‹As the growth is invariant under quasi-isometries, we deduce that it is impossible
to map quasi-isometrically a Euclidean space in a space of strictly smaller dimension.›
proposition quasi_isometry_on_euclidean:
fixes f::"'a::euclidean_space⇒'b::euclidean_space"
assumes "lambda C-quasi_isometry_on UNIV f"
shows "DIM('a) ≤ DIM('b)"
proof -
have C: "lambda ≥ 1" "C ≥ 0" using quasi_isometry_onD[OF assms] by auto
define D where "D = lambda * (C+1)"
define Ca where "Ca = (1/((max D 1) * DIM('a)))^(DIM('a))"
have "Ca > 0" unfolding Ca_def by auto
have A: "⋀R::real. R ≥ 0 ⟹ (∃F. (F ⊆ cball (0::'a::euclidean_space) R
∧ (∀x∈F. ∀y∈F. x = y ∨ dist x y ≥ D) ∧ finite F ∧ card F ≥ Ca * R^(DIM('a))))"
using growth_rate_euclidean_below[of _ D] unfolding Ca_def by blast
define Cb::real where "Cb = ((6/1)^(DIM('b)))"
have B: "⋀F (R::real). (F ⊆ cball (0::'b::euclidean_space) R ⟹ R ≥ 0 ⟹ (∀x∈F. ∀y∈F. x = y ∨ dist x y ≥ 1) ⟹ (finite F ∧ card F ≤ 1 + Cb * R^(DIM('b))))"
using growth_rate_euclidean_above[of 1] unfolding Cb_def by fastforce
have M: "Ca * R^(DIM('a)) ≤ 1 + Cb * (lambda * R + C + norm(f 0))^(DIM('b))" if "R ≥ 0" for R::real
proof -
obtain F::"'a set" where F: "F ⊆ cball 0 R" "∀x∈F. ∀y∈F. x = y ∨ dist x y ≥ D"
"finite F" "card F ≥ Ca * R^(DIM('a))"
using A[OF ‹R ≥ 0›] by auto
define G where "G = f`F"
have *: "dist (f x) (f y) ≥ 1" if "x ≠ y" "x ∈ F" "y ∈ F" for x y
proof -
have "dist x y ≥ D" using that F(2) by auto
have "1 = (1/lambda) * D - C" using ‹lambda ≥ 1› unfolding D_def by auto
also have "... ≤ (1/lambda) * dist x y - C"
using ‹dist x y ≥ D› ‹lambda ≥ 1› by (auto simp add: divide_simps)
also have "... ≤ dist (f x) (f y)"
using quasi_isometry_onD[OF assms] by auto
finally show ?thesis by simp
qed
then have "inj_on f F" unfolding inj_on_def by force
then have "card G = card F" unfolding G_def by (simp add: card_image)
then have "card G ≥ Ca * R^(DIM('a))" using F by auto
moreover have "finite G ∧ card G ≤ 1 + Cb * (lambda * R + C + norm(f 0))^(DIM('b))"
proof (rule B)
show "0 ≤ lambda * R + C + norm (f 0)" using ‹R ≥ 0› ‹C ≥ 0› ‹lambda ≥ 1› by auto
show "∀x∈G. ∀y∈G. x = y ∨ 1 ≤ dist x y" using * unfolding G_def by (auto, metis)
show "G ⊆ cball 0 (lambda * R + C + norm (f 0))"
unfolding G_def proof (auto)
fix x assume "x ∈ F"
have "norm (f x) ≤ norm (f 0) + dist (f x) (f 0)"
by (metis dist_0_norm dist_triangle2)
also have "... ≤ norm (f 0) + (lambda * dist x 0 + C)"
by (intro mono_intros quasi_isometry_onD(1)[OF assms]) auto
also have "... ≤ norm (f 0) + lambda * R + C"
using ‹x ∈ F› ‹F ⊆ cball 0 R› ‹lambda ≥ 1› by auto
finally show "norm (f x) ≤ lambda * R + C + norm (f 0)" by auto
qed
qed
ultimately show "Ca * R^(DIM('a)) ≤ 1 + Cb * (lambda * R + C + norm(f 0))^(DIM('b))"
by auto
qed
define CB where "CB = max Cb 0"
have "CB ≥ 0" "CB ≥ Cb" unfolding CB_def by auto
define D::real where "D = (1 + CB * (lambda + C + norm(f 0))^(DIM('b)))/Ca"
have Rineq: "R^(DIM('a)) ≤ D * R^(DIM('b))" if "R ≥ 1" for R::real
proof -
have "Ca * R^(DIM('a)) ≤ 1 + Cb * (lambda * R + C + norm(f 0))^(DIM('b))"
using M ‹R ≥ 1› by auto
also have "... ≤ 1 + CB * (lambda * R + C + norm(f 0))^(DIM('b))"
using ‹CB ≥ Cb› ‹lambda ≥ 1› ‹R ≥ 1› ‹C ≥ 0› by (auto intro!: mult_right_mono)
also have "... ≤ R^(DIM('b)) + CB * (lambda * R + C * R + norm(f 0) * R)^(DIM('b))"
using ‹lambda ≥ 1› ‹R ≥ 1› ‹C ≥ 0› ‹CB ≥ 0› by (auto intro!: mono_intros)
also have "... = (1 + CB * (lambda + C + norm(f 0))^(DIM('b))) * R^(DIM('b))"
by (auto simp add: algebra_simps power_mult_distrib[symmetric])
finally show ?thesis
using ‹Ca > 0› unfolding D_def by (auto simp add: divide_simps algebra_simps)
qed
show "DIM('a) ≤ DIM('b)"
proof (rule ccontr)
assume "¬(DIM('a) ≤ DIM('b))"
then obtain n where "DIM('a) = DIM('b) + n" "n > 0"
by (metis less_imp_add_positive not_le)
have "D ≥ 1" using Rineq[of 1] by auto
define R where "R = 2 * D"
then have "R ≥ 1" using ‹D ≥ 1› by auto
have "R^n * R^(DIM('b)) = R^(DIM('a))"
unfolding ‹DIM('a) = DIM('b) + n› by (auto simp add: power_add)
also have "... ≤ D * R^(DIM('b))" using Rineq[OF ‹R ≥ 1›] by auto
finally have "R^n ≤ D" using ‹R ≥ 1› by auto
moreover have "2 * D ≤ R^n" unfolding R_def using ‹D ≥ 1› ‹n > 0›
by (metis One_nat_def Suc_leI ‹1 ≤ R› ‹R ≡ 2 * D› less_eq_real_def power_increasing_iff power_one power_one_right)
ultimately show False using ‹D ≥ 1› by auto
qed
qed
text ‹As a particular case, we deduce that two quasi-isometric Euclidean spaces have the
same dimension.›
theorem quasi_isometric_euclidean:
assumes "quasi_isometric (UNIV::'a::euclidean_space set) (UNIV::'b::euclidean_space set)"
shows "DIM('a) = DIM('b)"
proof -
obtain lambda C and f::"'a ⇒'b" where "lambda C-quasi_isometry_on UNIV f"
using assms unfolding quasi_isometric_def quasi_isometry_between_def by auto
then have *: "DIM('a) ≤ DIM('b)" using quasi_isometry_on_euclidean by auto
have "quasi_isometric (UNIV::'b::euclidean_space set) (UNIV::'a::euclidean_space set)"
using quasi_isometric_equiv_rel(3)[OF assms] by auto
then obtain lambda C and f::"'b ⇒'a" where "lambda C-quasi_isometry_on UNIV f"
unfolding quasi_isometric_def quasi_isometry_between_def by auto
then have "DIM('b) ≤ DIM('a)" using quasi_isometry_on_euclidean by auto
then show ?thesis using * by auto
qed
text ‹A different (and important) way to prove the above statement would be to use asymptotic
cones. Here, it can be done in an elementary way: start with a quasi-isometric map $f$, and
consider a limit (defined with a ultrafilter) of $x\mapsto f(n x)/n$. This is a map which
contracts and expands the distances by at most $\lambda$. In particular, it is a homeomorphism
on its image. No such map exists if the dimension of the target is smaller than the dimension
of the source (invariance of domain theorem, already available in the library).
The above argument using growth is more elementary to write, though.›
subsection ‹Quasi-geodesics›
text ‹A quasi-geodesic is a quasi-isometric embedding of a real segment into a metric space. As the
embedding need not be continuous, a quasi-geodesic does not have to be compact, nor connected, which
can be a problem. However, in a geodesic space, it is always possible to deform a quasi-geodesic
into a continuous one (at the price of worsening the quasi-isometry constants). This is the content
of the proposition \verb+quasi_geodesic_made_lipschitz+ below, which is a variation around Lemma
III.H.1.11 in~\cite{bridson_haefliger}. The strategy of the proof is simple: assume that the
quasi-geodesic $c$ is defined on $[a,b]$. Then, on the points $a$, $a+C/\lambda$, $\cdots$,
$a+ N \cdot C/\lambda$, $b$, take $d$ equal to $c$, where $N$ is chosen so that the distance
between the last point and $b$ is in $[C/\lambda, 2C/\lambda)$. In the intervals, take $d$ to
be geodesic.›
proposition (in geodesic_space) quasi_geodesic_made_lipschitz:
fixes c::"real ⇒ 'a"
assumes "lambda C-quasi_isometry_on {a..b} c" "dist (c a) (c b) ≥ 2 * C"
shows "∃d. continuous_on {a..b} d ∧ d a = c a ∧ d b = c b
∧ (∀x∈{a..b}. dist (c x) (d x) ≤ 4 * C)
∧ lambda (4 * C)-quasi_isometry_on {a..b} d
∧ (2 * lambda)-lipschitz_on {a..b} d
∧ hausdorff_distance (c`{a..b}) (d`{a..b}) ≤ 2 * C"
proof -
consider "C = 0" | "C > 0 ∧ b ≤ a" | "C > 0 ∧ a < b ∧ b ≤ a + 2 * C/lambda" | "C > 0 ∧ a +2 * C/lambda < b"
using quasi_isometry_onD(4)[OF assms(1)] by fastforce
then show ?thesis
proof (cases)
text ‹If the original function is Lipschitz, we can use it directly.›
case 1
have "lambda-lipschitz_on {a..b} c"
apply (rule lipschitz_onI) using 1 quasi_isometry_onD[OF assms(1)] by auto
then have a: "(2 * lambda)-lipschitz_on {a..b} c"
apply (rule lipschitz_on_mono) using quasi_isometry_onD[OF assms(1)] assms by (auto simp add: divide_simps)
then have b: "continuous_on {a..b} c"
using lipschitz_on_continuous_on by blast
have "continuous_on {a..b} c ∧ c a = c a ∧ c b = c b
∧ (∀x∈{a..b}. dist (c x) (c x) ≤ 4 * C)
∧ lambda (4 * C)-quasi_isometry_on {a..b} c
∧ (2 * lambda)-lipschitz_on {a..b} c
∧ hausdorff_distance (c`{a..b}) (c`{a..b}) ≤ 2 * C"
using 1 a b assms(1) by auto
then show ?thesis by blast
next
text ‹If the original interval is empty, anything will do.›
case 2
then have "b < a" using assms(2) less_eq_real_def by auto
then have *: "{a..b} = {}" by auto
have a: "(2 * lambda)-lipschitz_on {a..b} c"
unfolding * apply (rule lipschitz_intros) using quasi_isometry_onD[OF assms(1)] assms by (auto simp add: divide_simps)
then have b: "continuous_on {a..b} c"
using lipschitz_on_continuous_on by blast
have "continuous_on {a..b} c ∧ c a = c a ∧ c b = c b
∧ (∀x∈{a..b}. dist (c x) (c x) ≤ 4 * C)
∧ lambda (4 * C)-quasi_isometry_on {a..b} c
∧ (2 * lambda)-lipschitz_on {a..b} c
∧ hausdorff_distance (c`{a..b}) (c`{a..b}) ≤ 2 * C"
using a b quasi_isometry_on_empty assms(1) quasi_isometry_onD[OF assms(1)] * assms by auto
then show ?thesis by blast
next
text ‹If the original interval is short, we can use a direct geodesic interpolation between
its endpoints›
case 3
then have C: "C > 0" "lambda ≥ 1" using quasi_isometry_onD[OF assms(1)] by auto
have [mono_intros]: "1/lambda ≤ lambda" using C by (simp add: divide_simps mult_ge1_powers(1))
have "a < b" using 3 by simp
have "2 * C ≤ dist (c a) (c b)" using assms by auto
also have "... ≤ lambda * dist a b + C"
using quasi_isometry_onD[OF assms(1)] ‹a < b› by auto
also have "... = lambda * (b-a) + C"
using ‹a < b› dist_real_def by auto
finally have *: "C ≤ (b-a) * lambda" by (auto simp add: algebra_simps)
define d where "d = (λx. geodesic_segment_param {(c a)--(c b)} (c a) ((dist (c a) (c b) /(b-a)) * (x-a)))"
have dend: "d a = c a" "d b = c b" unfolding d_def using ‹a < b› by auto
have Lip: "(2 * lambda)-lipschitz_on {a..b} d"
proof -
have "(1 * (((2 * lambda)) * (1+0)))-lipschitz_on {a..b} (λx. geodesic_segment_param {(c a)--(c b)} (c a) ((dist (c a) (c b) /(b-a)) * (x-a)))"
proof (rule lipschitz_on_compose2[of _ _ "λx. ((dist (c a) (c b) /(b-a)) * (x-a))"], intro lipschitz_intros)
have "(λx. dist (c a) (c b) / (b-a) * (x - a)) ` {a..b} ⊆ {0..dist (c a) (c b)}"
apply auto using ‹a < b› by (auto simp add: algebra_simps divide_simps intro: mult_right_mono)
moreover have "1-lipschitz_on {0..dist (c a) (c b)} (geodesic_segment_param {c a--c b} (c a))"
by (rule isometry_on_lipschitz, simp)
ultimately show "1-lipschitz_on ((λx. dist (c a) (c b) / (b-a) * (x - a)) ` {a..b}) (geodesic_segment_param {c a--c b} (c a))"
using lipschitz_on_subset by auto
have "dist (c a) (c b) ≤ lambda * dist a b + C"
apply (rule quasi_isometry_onD(1)[OF assms(1)])
using ‹a < b› by auto
also have "... = lambda * (b - a) + C"
unfolding dist_real_def using ‹a < b› by auto
also have "... ≤ 2 * lambda * (b-a)"
using * by (auto simp add: algebra_simps)
finally show "¦dist (c a) (c b) / (b - a)¦ ≤ 2 * lambda"
using ‹a < b› by (auto simp add: divide_simps)
qed
then show ?thesis unfolding d_def by auto
qed
have dist_c_d: "dist (c x) (d x) ≤ 4 * C" if H: "x ∈ {a..b}" for x
proof -
have "(x-a) + (b - x) ≤ 2 * C/lambda"
using that 3 by auto
then consider "x-a ≤ C/lambda" | "b - x ≤ C/lambda" by linarith
then have "∃v∈{a,b}. dist x v ≤ C/lambda"
proof (cases)
case 1
show ?thesis
apply (rule bexI[of _ a]) using 1 H by (auto simp add: dist_real_def)
next
case 2
show ?thesis
apply (rule bexI[of _ b]) using 2 H by (auto simp add: dist_real_def)
qed
then obtain v where v: "v ∈ {a,b}" "dist x v ≤ C/lambda" by auto
have "dist (c x) (d x) ≤ dist (c x) (c v) + dist (c v) (d v) + dist (d v) (d x)"
by (intro mono_intros)
also have "... ≤ (lambda * dist x v + C) + 0 + ((2 * lambda) * dist v x)"
apply (intro mono_intros quasi_isometry_onD(1)[OF assms(1)] that lipschitz_onD[OF Lip])
using v ‹a < b› dend by auto
also have "... ≤ (lambda * (C/lambda) + C) + 0 + ((2 * lambda) * (C/lambda))"
apply (intro mono_intros) using C v by (auto simp add: metric_space_class.dist_commute)
finally show ?thesis
using C by (auto simp add: algebra_simps divide_simps)
qed
text ‹A similar argument shows that the Hausdorff distance between the images is bounded by $2C$.›
have "hausdorff_distance (c`{a..b}) (d`{a..b}) ≤ 2 * C"
proof (rule hausdorff_distanceI2)
show "0 ≤ 2 * C" using C by auto
fix z assume "z ∈ c`{a..b}"
then obtain x where x: "x ∈ {a..b}" "z = c x" by auto
have "(x-a) + (b - x) ≤ 2 * C/lambda"
using x 3 by auto
then consider "x-a ≤ C/lambda" | "b - x ≤ C/lambda" by linarith
then have "∃v∈{a,b}. dist x v ≤ C/lambda"
proof (cases)
case 1
show ?thesis
apply (rule bexI[of _ a]) using 1 x by (auto simp add: dist_real_def)
next
case 2
show ?thesis
apply (rule bexI[of _ b]) using 2 x by (auto simp add: dist_real_def)
qed
then obtain v where v: "v ∈ {a,b}" "dist x v ≤ C/lambda" by auto
have "dist z (d v) = dist (c x) (c v)" unfolding x(2) using v dend by auto
also have "... ≤ lambda * dist x v + C"
apply (rule quasi_isometry_onD(1)[OF assms(1)]) using v(1) x(1) by auto
also have "... ≤ lambda * (C/lambda) + C"
apply (intro mono_intros) using C v(2) by auto
also have "... = 2 * C"
using C by (simp add: divide_simps)
finally have *: "dist z (d v) ≤ 2 * C" by simp
show "∃y∈d ` {a..b}. dist z y ≤ 2 * C"
apply (rule bexI[of _ "d v"]) using * v(1) ‹a < b› by auto
next
fix z assume "z ∈ d`{a..b}"
then obtain x where x: "x ∈ {a..b}" "z = d x" by auto
have "(x-a) + (b - x) ≤ 2 * C/lambda"
using x 3 by auto
then consider "x-a ≤ C/lambda" | "b - x ≤ C/lambda" by linarith
then have "∃v∈{a,b}. dist x v ≤ C/lambda"
proof (cases)
case 1
show ?thesis
apply (rule bexI[of _ a]) using 1 x by (auto simp add: dist_real_def)
next
case 2
show ?thesis
apply (rule bexI[of _ b]) using 2 x by (auto simp add: dist_real_def)
qed
then obtain v where v: "v ∈ {a,b}" "dist x v ≤ C/lambda" by auto
have "dist z (c v) = dist (d x) (d v)" unfolding x(2) using v dend by auto
also have "... ≤ 2 * lambda * dist x v"
apply (rule lipschitz_onD(1)[OF Lip]) using v(1) x(1) by auto
also have "... ≤ 2 * lambda * (C/lambda)"
apply (intro mono_intros) using C v(2) by auto
also have "... = 2 * C"
using C by (simp add: divide_simps)
finally have *: "dist z (c v) ≤ 2 * C" by simp
show "∃y∈c`{a..b}. dist z y ≤ 2 * C"
apply (rule bexI[of _ "c v"]) using * v(1) ‹a < b› by auto
qed
have "lambda (4 * C)-quasi_isometry_on {a..b} d"
proof
show "1 ≤ lambda" using C by auto
show "0 ≤ 4 * C" using C by auto
show "dist (d x) (d y) ≤ lambda * dist x y + 4 * C" if "x ∈ {a..b}" "y ∈ {a..b}" for x y
proof -
have "dist (d x) (d y) ≤ 2 * lambda * dist x y"
apply (rule lipschitz_onD[OF Lip]) using that by auto
also have "... = lambda * dist x y + lambda * dist x y"
by auto
also have "... ≤ lambda * dist x y + lambda * (2 * C/lambda)"
apply (intro mono_intros) using 3 that C unfolding dist_real_def by auto
also have "... = lambda * dist x y + 2 * C"
using C by (simp add: algebra_simps divide_simps)
finally show ?thesis using C by auto
qed
show "1 / lambda * dist x y - 4 * C ≤ dist (d x) (d y)" if "x ∈ {a..b}" "y ∈ {a..b}" for x y
proof -
have "1/lambda * dist x y - 4 * C ≤ lambda * dist x y - 2 * C"
apply (intro mono_intros) using C by auto
also have "... ≤ lambda * (2 * C/lambda) - 2 * C"
apply (intro mono_intros) using that 3 C unfolding dist_real_def by auto
also have "... = 0"
using C by (auto simp add: algebra_simps divide_simps)
also have "... ≤ dist (d x) (d y)" by auto
finally show ?thesis by simp
qed
qed
then have "continuous_on {a..b} d ∧ d a = c a ∧ d b = c b
∧ lambda (4 * C)-quasi_isometry_on {a..b} d
∧ (∀x∈{a..b}. dist (c x) (d x) ≤ 4 *C)
∧ (2*lambda)-lipschitz_on {a..b} d
∧ hausdorff_distance (c`{a..b}) (d`{a..b}) ≤ 2 * C"
using dist_c_d ‹d a = c a› ‹d b = c b› ‹(2*lambda)-lipschitz_on {a..b} d›
‹hausdorff_distance (c`{a..b}) (d`{a..b}) ≤ 2 * C› lipschitz_on_continuous_on by auto
then show ?thesis by auto
next
text ‹Now, for the only nontrivial case, we use geodesic interpolation between the points
$a$, $a + C/\lambda$, $\cdots$, $a+N\cdot C/\lambda$, $b'$, $b$ where $N$ is chosen so that
the distance between $a+N C/\lambda$ and $b$ belongs to $[2C/\lambda, 3C/\lambda)$, and
$b'$ is the middle of this interval. This gives a decomposition into intervals of length
at most $3/2\cdot C/\lambda$.›
case 4
then have C: "C > 0" "lambda ≥ 1" using quasi_isometry_onD[OF assms(1)] by auto
have "a < b" using 4 C by (smt divide_pos_pos)
have [mono_intros]: "1/lambda ≤ lambda" using C by (simp add: divide_simps mult_ge1_powers(1))
define N where "N = floor((b-a)/(C/lambda)) - 2"
have N: "N ≤ (b-a)/(C/lambda)-2" "(b-a)/(C/lambda) ≤ N + (3::real)"
unfolding N_def by linarith+
have "2 < (b-a)/(C/lambda)"
using C 4 by (auto simp add: divide_simps algebra_simps)
then have N0 : "0 ≤ N" unfolding N_def by auto
define p where "p = (λt::int. a + (C/lambda) * t)"
have pmono: "p i ≤ p j" if "i ≤ j" for i j
unfolding p_def using that C by (auto simp add: algebra_simps divide_simps)
have pmono': "p i < p j" if "i < j" for i j
unfolding p_def using that C by (auto simp add: algebra_simps divide_simps)
have "p (N+1) ≤ b"
unfolding p_def using C N by (auto simp add: algebra_simps divide_simps)
then have pb: "p i ≤ b" if "i ∈ {0..N}" for i
using that pmono by (meson atLeastAtMost_iff linear not_le order_trans zle_add1_eq_le)
have bpN: "b - p N ∈ {2 * C/lambda .. 3 * C/lambda}"
unfolding p_def using C N apply (auto simp add: divide_simps)
by (auto simp add: algebra_simps)
have "p N < b" using pmono'[of N "N+1"] ‹p (N+1) ≤ b› by auto
define b' where "b' = (b + p N)/2"
have b': "p N < b'" "b' < b" using ‹p N < b› unfolding b'_def by auto
have pb': "p i ≤ b'" if "i ∈ {0..N}" for i
using pmono[of i N] b' that by auto
text ‹Introduce the set $A$ along which one will discretize.›
define A where "A = p`{0..N} ∪ {b', b}"
have "finite A" unfolding A_def by auto
have "b ∈ A" unfolding A_def by auto
have "p 0 ∈ A" unfolding A_def using ‹0 ≤ N› by auto
moreover have pa: "p 0 = a" unfolding p_def by auto
ultimately have "a ∈ A" by auto
have "A ⊆ {a..b}"
unfolding A_def using ‹a < b› b' pa pb pmono N0 by fastforce
then have "b' ∈ {a..<b}" unfolding A_def using ‹b' < b› by auto
have A : "finite A" "A ⊆ {a..b}" "a ∈ A" "b ∈ A" "a < b" by fact+
have nx: "next_in A x = x + C/lambda" if "x ∈ A" "x ≠ b" "x ≠ b'" "x ≠ p N" for x
proof (rule next_inI[OF A])
show "x ∈ {a..<b}" using ‹x ∈ A› ‹A ⊆ {a..b}› ‹x ≠ b› by auto
obtain i where i: "x = p i" "i ∈ {0..N}"
using ‹x ∈ A› ‹x ≠ b› ‹x ≠ b'› unfolding A_def by auto
have *: "p (i+1) = x + C/lambda" unfolding i(1) p_def by (auto simp add: algebra_simps)
have "i ≠ N" using that i by auto
then have "i + 1 ∈ {0..N}" using ‹i ∈ {0..N}› by auto
then have "p (i+1) ∈ A" unfolding A_def by fastforce
then show "x + C/lambda ∈ A" unfolding * by auto
show "x < x + C / lambda" using C by auto
show "{x<..<x + C / lambda} ∩ A = {}"
proof (auto)
fix y assume y: "y ∈ A" "x < y" "y < x + C/lambda"
consider "y = b" | "y = b'" | "∃j≤i. y = p j" | "∃j>i. y = p j"
using ‹y ∈ A› not_less unfolding A_def by auto
then show False
proof (cases)
case 1
have "x + C/lambda ≤ b" unfolding *[symmetric] using ‹i + 1 ∈ {0..N}› pb by auto
then show False using y(3) unfolding 1 i(1) by auto
next
case 2
have "x + C/lambda ≤ b'" unfolding *[symmetric] using ‹i + 1 ∈ {0..N}› pb' by auto
then show False using y(3) unfolding 2 i(1) by auto
next
case 3
then obtain j where j: "j ≤ i" "y = p j" by auto
have "y ≤ x" unfolding j(2) i(1) using pmono[OF ‹j ≤ i›] by simp
then show False using ‹x < y› by auto
next
case 4
then obtain j where j: "j > i" "y = p j" by auto
then have "i+1 ≤ j" by auto
have "x + C/lambda ≤ y" unfolding j(2) *[symmetric] using pmono[OF ‹i+1 ≤ j›] by auto
then show False using ‹y < x + C/lambda› by auto
qed
qed
qed
have npN: "next_in A (p N) = b'"
proof (rule next_inI[OF A])
show "p N ∈ {a..<b}" using pa pmono ‹0 ≤ N› ‹p N < b› by auto
show "p N < b'" by fact
show "b' ∈ A" unfolding A_def by auto
show "{p N<..<b'} ∩ A = {}"
unfolding A_def using pmono b' by force
qed
have nb': "next_in A (b') = b"
proof (rule next_inI[OF A])
show "b' ∈ {a..<b}" using A_def A ‹b' < b› by auto
show "b' < b" by fact
show "b ∈ A" by fact
show "{b'<..<b} ∩ A = {}"
unfolding A_def using pmono b' by force
qed
have gap: "next_in A x - x ∈ {C/lambda.. 3/2 * C/lambda}" if "x ∈ A - {b}" for x
proof (cases "x = p N ∨ x = b'")
case True
then show ?thesis using npN nb' bpN b'_def by force
next
case False
have *: "next_in A x = x + C/lambda"
apply (rule nx) using that False by auto
show ?thesis unfolding * using C by (auto simp add: algebra_simps divide_simps)
qed
text ‹We can now define the function $d$, by geodesic interpolation between points in $A$.›
define d where "d x = (if x ∈ A then c x
else geodesic_segment_param {c (prev_in A x) -- c (next_in A x)} (c (prev_in A x))
((x - prev_in A x)/(next_in A x - prev_in A x) * dist (c(prev_in A x)) (c(next_in A x))))" for x
have "d a = c a" "d b = c b" unfolding d_def using ‹a ∈ A› ‹b ∈ A› by auto
text ‹To prove the Lipschitz continuity, we argue that $d$ is Lipschitz on finitely many intervals,
that cover the interval $[a,b]$, the intervals between points in $A$.
There is a formula for $d$ on them (the nontrivial point is that the above formulas for $d$
match at the boundaries).›
have *: "d x = geodesic_segment_param {(c u)--(c v)} (c u) ((dist (c u) (c v) /(v-u)) * (x-u))"
if "u ∈ A - {b}" "v = next_in A u" "x ∈ {u..v}" for x u v
proof -
have "u ∈ {a..<b}" using that ‹A ⊆ {a..b}› by fastforce
have H: "u ∈ A" "v ∈ A" "u < v" "A ∩ {u<..<v} = {}" using that next_in_basics[OF A ‹u ∈ {a..<b}›] by auto
consider "x = u" | "x = v" | "x ∈ {u<..<v}" using ‹x ∈ {u..v}› by fastforce
then show ?thesis
proof (cases)
case 1
then have "d x = c u" unfolding d_def using ‹u ∈ A- {b}› ‹A ⊆ {a..b}› by auto
then show ?thesis unfolding 1 by auto
next
case 2
then have "d x = c v" unfolding d_def using ‹v ∈ A› ‹A ⊆ {a..b}› by auto
then show ?thesis unfolding 2 using ‹u < v› by auto
next
case 3
have *: "prev_in A x = u"
apply (rule prev_inI[OF A]) using 3 H ‹A ⊆ {a..b}› by auto
have **: "next_in A x = v"
apply (rule next_inI[OF A]) using 3 H ‹A ⊆ {a..b}› by auto
show ?thesis unfolding d_def * ** using 3 H ‹A ∩ {u<..<v} = {}› ‹A ⊆ {a..b}›
by (auto simp add: algebra_simps)
qed
qed
text ‹From the above formula, we deduce that $d$ is Lipschitz on those intervals.›
have lip0: "(lambda + C / (next_in A u - u))-lipschitz_on {u..next_in A u} d" if "u ∈ A - {b}" for u
proof -
define v where "v = next_in A u"
have "u ∈ {a..<b}" using that ‹A ⊆ {a..b}› by fastforce
have "u ∈ A" "v ∈ A" "u < v" "A ∩ {u<..<v} = {}"
unfolding v_def using that next_in_basics[OF A ‹u ∈ {a..<b}›] by auto
have "(1 * (((lambda + C / (next_in A u - u))) * (1+0)))-lipschitz_on {u..v} (λx. geodesic_segment_param {(c u)--(c v)} (c u) ((dist (c u) (c v) /(v-u)) * (x-u)))"
proof (rule lipschitz_on_compose2[of _ _ "λx. ((dist (c u) (c v) /(v-u)) * (x-u))"], intro lipschitz_intros)
have "(λx. dist (c u) (c v) / (v - u) * (x - u)) ` {u..v} ⊆ {0..dist (c u) (c v)}"
apply auto using ‹u < v› by (auto simp add: algebra_simps divide_simps intro: mult_right_mono)
moreover have "1-lipschitz_on {0..dist (c u) (c v)} (geodesic_segment_param {c u--c v} (c u))"
by (rule isometry_on_lipschitz, simp)
ultimately show "1-lipschitz_on ((λx. dist (c u) (c v) / (v - u) * (x - u)) ` {u..v}) (geodesic_segment_param {c u--c v} (c u))"
using lipschitz_on_subset by auto
have "dist (c u) (c v) ≤ lambda * dist u v + C"
apply (rule quasi_isometry_onD(1)[OF assms(1)])
using ‹u ∈ A› ‹v ∈ A› ‹A ⊆ {a..b}› by auto
also have "... = lambda * (v - u) + C"
unfolding dist_real_def using ‹u < v› by auto
finally show "¦dist (c u) (c v) / (v - u)¦ ≤ lambda + C / (next_in A u - u)"
using ‹u < v› unfolding v_def by (auto simp add: divide_simps)
qed
then show ?thesis
using *[OF ‹u ∈ A -{b}› ‹v = next_in A u›] unfolding v_def
by (auto intro: lipschitz_on_transform)
qed
have lip: "(2 * lambda)-lipschitz_on {u..next_in A u} d" if "u ∈ A - {b}" for u
proof (rule lipschitz_on_mono[OF lip0[OF that]], auto)
define v where "v = next_in A u"
have "u ∈ {a..<b}" using that ‹A ⊆ {a..b}› by fastforce
have "u ∈ A" "v ∈ A" "u < v" "A ∩ {u<..<v} = {}"
unfolding v_def using that next_in_basics[OF A ‹u ∈ {a..<b}›] by auto
have Duv: "v - u ∈ {C/lambda .. 2 * C/lambda}"
unfolding v_def using gap[OF ‹u ∈ A - {b}›] by simp
then show " C / (next_in A u - u) ≤ lambda"
using ‹u < v› C unfolding v_def by (auto simp add: algebra_simps divide_simps)
qed
text ‹The Lipschitz continuity of $d$ now follows from its Lipschitz continuity on each
subinterval in $I$.›
have Lip: "(2 * lambda)-lipschitz_on {a..b} d"
apply (rule lipschitz_on_closed_Union[of "{{u..next_in A u} |u. u ∈ A - {b}}" _ "λx. x"])
using lip ‹finite A› C intervals_decomposition[OF A] using assms by auto
then have "continuous_on {a..b} d"
using lipschitz_on_continuous_on by auto
text ‹$d$ has good upper controls on each basic interval.›
have QI0: "dist (d x) (d y) ≤ lambda * dist x y + C"
if H: "u ∈ A - {b}" "x ∈ {u..next_in A u}" "y ∈ {u..next_in A u}" for u x y
proof -
have "u < next_in A u" using H(1) A next_in_basics(2)[OF A] by auto
moreover have "dist x y ≤ next_in A u - u" unfolding dist_real_def using H by auto
ultimately have *: "dist x y / (next_in A u - u) ≤ 1" by (simp add: divide_simps)
have "dist (d x) (d y) ≤ (lambda + C / (next_in A u - u)) * dist x y"
by (rule lipschitz_onD[OF lip0[OF H(1)] H(2) H(3)])
also have "... = lambda * dist x y + C * (dist x y / (next_in A u - u))"
by (simp add: algebra_simps)
also have "... ≤ lambda * dist x y + C * 1"
apply (intro mono_intros) using C * by auto
finally show ?thesis by simp
qed
text ‹We can now show that $c$ and $d$ are pointwise close. This follows from the fact that they
coincide on $A$ and are well controlled in between (for $c$, this is a consequence of the choice
of $A$. For $d$, it follows from the fact that it is geodesic in the intervals).›
have dist_c_d: "dist (c x) (d x) ≤ 4 * C" if "x ∈ {a..b}" for x
proof -
obtain u where u: "u ∈ A - {b}" "x ∈ {u..next_in A u}"
using ‹x ∈ {a..b}› intervals_decomposition[OF A] by blast
have "(x-u) + (next_in A u - x) ≤ 2 * C/lambda"
using gap[OF u(1)] by auto
then consider "x-u ≤ C/lambda" | "next_in A u - x ≤ C/lambda" by linarith
then have "∃v∈A. dist x v ≤ C/lambda"
proof (cases)
case 1
show ?thesis
apply (rule bexI[of _ u]) using 1 u by (auto simp add: dist_real_def)
next
case 2
show ?thesis
apply (rule bexI[of _ "next_in A u"]) using 2 u A(2)
by (auto simp add: dist_real_def intro!:next_in_basics[OF A])
qed
then obtain v where v: "v ∈ A" "dist x v ≤ C/lambda" by auto
have "dist (c x) (d x) ≤ dist (c x) (c v) + dist (c v) (d v) + dist (d v) (d x)"
by (intro mono_intros)
also have "... ≤ (lambda * dist x v + C) + 0 + ((2 * lambda) * dist v x)"
apply (intro mono_intros quasi_isometry_onD(1)[OF assms(1)] that lipschitz_onD[OF Lip])
using A(2) ‹v ∈ A› apply blast
using ‹v ∈ A› d_def apply auto[1]
using A(2) ‹v ∈ A› by blast
also have "... ≤ (lambda * (C/lambda) + C) + 0 + ((2 * lambda) * (C/lambda))"
apply (intro mono_intros) using v(2) C by (auto simp add: metric_space_class.dist_commute)
finally show ?thesis
using C by (auto simp add: algebra_simps divide_simps)
qed
text ‹A similar argument shows that the Hausdorff distance between the images is bounded by $2C$.›
have "hausdorff_distance (c`{a..b}) (d`{a..b}) ≤ 2 * C"
proof (rule hausdorff_distanceI2)
show "0 ≤ 2 * C" using C by auto
fix z assume "z ∈ c`{a..b}"
then obtain x where x: "x ∈ {a..b}" "z = c x" by auto
then obtain u where u: "u ∈ A - {b}" "x ∈ {u..next_in A u}"
using intervals_decomposition[OF A] by blast
have "(x-u) + (next_in A u - x) ≤ 2 * C/lambda"
using gap[OF u(1)] by auto
then consider "x-u ≤ C/lambda" | "next_in A u - x ≤ C/lambda" by linarith
then have "∃v∈A. dist x v ≤ C/lambda"
proof (cases)
case 1
show ?thesis
apply (rule bexI[of _ u]) using 1 u by (auto simp add: dist_real_def)
next
case 2
show ?thesis
apply (rule bexI[of _ "next_in A u"]) using 2 u A(2)
by (auto simp add: dist_real_def intro!:next_in_basics[OF A])
qed
then obtain v where v: "v ∈ A" "dist x v ≤ C/lambda" by auto
have "dist z (d v) = dist (c x) (c v)" unfolding x(2) d_def using ‹v ∈ A› by auto
also have "... ≤ lambda * dist x v + C"
apply (rule quasi_isometry_onD(1)[OF assms(1)]) using v(1) A(2) x(1) by auto
also have "... ≤ lambda * (C/lambda) + C"
apply (intro mono_intros) using C v(2) by auto
also have "... = 2 * C"
using C by (simp add: divide_simps)
finally have *: "dist z (d v) ≤ 2 * C" by simp
show "∃y∈d ` {a..b}. dist z y ≤ 2 * C"
apply (rule bexI[of _ "d v"]) using * v(1) A(2) by auto
next
fix z assume "z ∈ d`{a..b}"
then obtain x where x: "x ∈ {a..b}" "z = d x" by auto
then obtain u where u: "u ∈ A - {b}" "x ∈ {u..next_in A u}"
using intervals_decomposition[OF A] by blast
have "(x-u) + (next_in A u - x) ≤ 2 * C/lambda"
using gap[OF u(1)] by auto
then consider "x-u ≤ C/lambda" | "next_in A u - x ≤ C/lambda" by linarith
then have "∃v∈A. dist x v ≤ C/lambda"
proof (cases)
case 1
show ?thesis
apply (rule bexI[of _ u]) using 1 u by (auto simp add: dist_real_def)
next
case 2
show ?thesis
apply (rule bexI[of _ "next_in A u"]) using 2 u A(2)
by (auto simp add: dist_real_def intro!:next_in_basics[OF A])
qed
then obtain v where v: "v ∈ A" "dist x v ≤ C/lambda" by auto
have "dist z (c v) = dist (d x) (d v)" unfolding x(2) d_def using ‹v ∈ A› by auto
also have "... ≤ 2 * lambda * dist x v"
apply (rule lipschitz_onD(1)[OF Lip]) using v(1) A(2) x(1) by auto
also have "... ≤ 2 * lambda * (C/lambda)"
apply (intro mono_intros) using C v(2) by auto
also have "... = 2 * C"
using C by (simp add: divide_simps)
finally have *: "dist z (c v) ≤ 2 * C" by simp
show "∃y∈c`{a..b}. dist z y ≤ 2 * C"
apply (rule bexI[of _ "c v"]) using * v(1) A(2) by auto
qed
text ‹From the above controls, we check that $d$ is a quasi-isometry, with explicit constants.›
have "lambda (4 * C)-quasi_isometry_on {a..b} d"
proof
show "1 ≤ lambda" using C by auto
show "0 ≤ 4 * C" using C by auto
have I : "dist (d x) (d y) ≤ lambda * dist x y + 4 * C" if H: "x ∈ {a..b}" "y ∈ {a..b}" "x < y" for x y
proof -
obtain u where u: "u ∈ A - {b}" "x ∈ {u..next_in A u}"
using intervals_decomposition[OF A] H(1) by force
have "u ∈ {a..<b}" using u(1) A by auto
have "next_in A u ∈ A" using next_in_basics(1)[OF A ‹u ∈ {a..<b}›] by auto
obtain v where v: "v ∈ A - {b}" "y ∈ {v..next_in A v}"
using intervals_decomposition[OF A] H(2) by force
have "v ∈ {a..<b}" using v(1) A by auto
have "u < next_in A v" using H(3) u(2) v(2) by auto
then have "u ≤ v"
using u(1) next_in_basics(3)[OF A, OF ‹v ∈ {a..<b}›] by auto
show ?thesis
proof (cases "u = v")
case True
have "dist (d x) (d y) ≤ lambda * dist x y + C"
apply (rule QI0[OF u]) using v(2) True by auto
also have "... ≤ lambda * dist x y + 4 * C"
using C by auto
finally show ?thesis by simp
next
case False
then have "u < v" using ‹u ≤ v› by auto
then have "next_in A u ≤ v" using v(1) next_in_basics(3)[OF A, OF ‹u ∈ {a..<b}›] by auto
have d1: "d (next_in A u) = c (next_in A u)"
using ‹next_in A u ∈ A› unfolding d_def by auto
have d2: "d v = c v"
using v(1) unfolding d_def by auto
have "dist (d x) (d y) ≤ dist (d x) (d (next_in A u)) + dist (d (next_in A u)) (d v) + dist (d v) (d y)"
by (intro mono_intros)
also have "... ≤ (lambda * dist x (next_in A u) + C) + (lambda * dist (next_in A u) v + C)
+ (lambda * dist v y + C)"
apply (intro mono_intros)
apply (rule QI0[OF u]) using u(2) apply simp
apply (simp add: d1 d2) apply (rule quasi_isometry_onD(1)[OF assms(1)])
using ‹next_in A u ∈ A› ‹A ⊆ {a..b}› apply auto[1]
using ‹v ∈ A - {b}› ‹A ⊆ {a..b}› apply auto[1]
apply (rule QI0[OF v(1)]) using v(2) by auto
also have "... = lambda * dist x y + 3 * C"
unfolding dist_real_def
using ‹x ∈ {u..next_in A u}› ‹y ∈ {v..next_in A v}› ‹x < y› ‹next_in A u ≤ v›
by (auto simp add: algebra_simps)
finally show ?thesis using C by simp
qed
qed
show "dist (d x) (d y) ≤ lambda * dist x y + 4 * C" if H: "x ∈ {a..b}" "y ∈ {a..b}" for x y
proof -
consider "x < y" | "x = y" | "x > y" by linarith
then show ?thesis
proof (cases)
case 1
then show ?thesis using I[OF H(1) H(2) 1] by simp
next
case 2
show ?thesis unfolding 2 using C by auto
next
case 3
show ?thesis using I [OF H(2) H(1) 3] by (simp add: metric_space_class.dist_commute)
qed
qed
text ‹The lower bound is more tricky. We separate the case where $x$ and $y$ are in the same
interval, when they are in different nearby intervals, and when they are in different
separated intervals. The latter case is more difficult. In this case, one of the intervals
has length $C/\lambda$ and the other one has length at most $3/2\cdot C/\lambda$. There,
we approximate $dist (d x) (d y)$ by $dist (d u') (d v')$ where $u'$ and $v'$ are suitable
endpoints of the intervals containing respectively $x$ and $y$. We use the inner endpoint
(between $x$ and $y$) if the distance between $x$ or $y$ and this point is less than $2/5$
of the length of the interval, and the outer endpoint otherwise. The reason is that, with
the outer endpoints, we get right away an upper bound for the distance between $x$ and $y$,
while this is not the case with the inner endpoints where there is an additional error.
The equilibrium is reached at proportion $2/5$. ›
have J : "dist (d x) (d y) ≥ (1/lambda) * dist x y - 4 * C" if H: "x ∈ {a..b}" "y ∈ {a..b}" "x < y" for x y
proof -
obtain u where u: "u ∈ A - {b}" "x ∈ {u..next_in A u}"
using intervals_decomposition[OF A] H(1) by force
have "u ∈ {a..<b}" using u(1) A by auto
have "next_in A u ∈ A" using next_in_basics(1)[OF A ‹u ∈ {a..<b}›] by auto
obtain v where v: "v ∈ A - {b}" "y ∈ {v..next_in A v}"
using intervals_decomposition[OF A] H(2) by force
have "v ∈ {a..<b}" using v(1) A by auto
have "next_in A v ∈ A" using next_in_basics(1)[OF A ‹v ∈ {a..<b}›] by auto
have "u < next_in A v" using H(3) u(2) v(2) by auto
then have "u ≤ v"
using u(1) next_in_basics(3)[OF A, OF ‹v ∈ {a..<b}›] by auto
consider "v = u" | "v = next_in A u" | "v ≠ u ∧ v ≠ next_in A u" by auto
then show ?thesis
proof (cases)
case 1
have "(1/lambda) * dist x y - 4 * C ≤ lambda * dist x y - 4 * C"
apply (intro mono_intros) by auto
also have "... ≤ lambda * (3/2 * C/lambda) - 3/2 * C"
apply (intro mono_intros)
using u(2) v(2) unfolding 1 using C gap[OF u(1)] dist_real_def ‹x < y› by auto
also have "... = 0"
using C by auto
also have "... ≤ dist (d x) (d y)"
by auto
finally show ?thesis by simp
next
case 2
have "dist x y ≤ dist x (next_in A u) + dist v y"
unfolding 2 by (intro mono_intros)
also have "... ≤ 3/2 * C/lambda + 3/2 * C/lambda"
apply (intro mono_intros)
unfolding dist_real_def using u(2) v(2) gap[OF u(1)] gap[OF v(1)] by auto
finally have *: "dist x y ≤ 3 * C/lambda" by auto
have "(1/lambda) * dist x y - 4 * C ≤ lambda * dist x y - 4 * C"
apply (intro mono_intros) by auto
also have "... ≤ lambda * (3 * C/lambda) - 3 * C"
apply (intro mono_intros)
using * C by auto
also have "... = 0"
using C by auto
also have "... ≤ dist (d x) (d y)"
by auto
finally show ?thesis by simp
next
case 3
then have "u < v" using ‹u ≤ v› by auto
then have *: "next_in A u < v" using v(1) next_in_basics(3)[OF A ‹u ∈ {a..<b}›] 3 by auto
have nu: "next_in A u = u + C/lambda"
proof (rule nx)
show "u ∈ A" using u(1) by auto
show "u ≠ b" using u(1) by auto
show "u ≠ b'"
proof
assume H: "u = b'"
have "b < v" using * unfolding H nb' by simp
then show False using ‹v ∈ {a..<b}› by auto
qed
show "u ≠ p N"
proof
assume H: "u = p N"
have "b' < v" using * unfolding H npN by simp
then have "next_in A b' ≤ v" using next_in_basics(3)[OF A ‹b' ∈ {a..<b}›] v by force
then show False unfolding nb' using ‹v ∈ {a..<b}› by auto
qed
qed
have nv: "next_in A v ≤ v + 3/2 * C/lambda" using gap[OF v(1)] by auto
have d: "d u = c u" "d (next_in A u) = c (next_in A u)" "d v = c v" "d (next_in A v) = c (next_in A v)"
using ‹u ∈ A - {b}› ‹next_in A u ∈ A› ‹v ∈ A - {b}› ‹next_in A v ∈ A› unfolding d_def by auto
text ‹The interval containing $x$ has length $C/\lambda$, while the interval containing
$y$ has length at most $\leq 3/2 C/\lambda$. Therefore, $x$ is at proportion $2/5$ of the inner point
if $x > u + (3/5) C/\lambda$, and $y$ is at proportion $2/5$ of the inner point if
$y < v + (2/5) \cdot 3/2 \cdot C/\lambda = v + (3/5)C/\lambda$.›
consider "x ≤ u + (3/5) * C/lambda ∧ y ≤ v + (3/5) * C/lambda"
| "x ≥ u + (3/5) * C/lambda ∧ y ≤ v + (3/5) * C/lambda"
| "x ≤ u + (3/5) * C/lambda ∧ y ≥ v + (3/5) * C/lambda"
| "x ≥ u + (3/5) * C/lambda ∧ y ≥ v + (3/5) * C/lambda"
by linarith
then show ?thesis
proof (cases)
case 1
have "(1/lambda) * dist u v - C ≤ dist (c u) (c v)"
apply (rule quasi_isometry_onD(2)[OF assms(1)])
using ‹u ∈ A - {b}› ‹v ∈ A - {b}› ‹A ⊆ {a..b}› by auto
also have "... = dist (d u) (d v)"
using d by auto
also have "... ≤ dist (d u) (d x) + dist (d x) (d y) + dist (d y) (d v)"
by (intro mono_intros)
also have "... ≤ (2 * lambda * dist u x) + dist (d x) (d y) + (2 * lambda * dist y v)"
apply (intro mono_intros)
apply (rule lipschitz_onD[OF lip[OF u(1)]]) using u(2) apply auto[1] using u(2) apply auto[1]
apply (rule lipschitz_onD[OF lip[OF v(1)]]) using v(2) by auto
also have "... ≤ (2 * lambda * (3/5 * C/lambda)) + dist (d x) (d y) + (2 * lambda * (3/5 * C/lambda))"
apply (intro mono_intros)
unfolding dist_real_def using 1 u v C by auto
also have "... = 12/5 * C + dist (d x) (d y)"
using C by (auto simp add: algebra_simps divide_simps)
finally have *: "(1/lambda) * dist u v ≤ dist (d x) (d y) + 17/5 * C" by auto
have "(1/lambda) * dist x y ≤ (1/lambda) * (dist u v + dist v y)"
apply (intro mono_intros)
unfolding dist_real_def using C u(2) v(2) ‹x < y› by auto
also have "... ≤ (1/lambda) * (dist u v + 3/5 * C/lambda)"
apply (intro mono_intros)
unfolding dist_real_def using 1 v(2) C by auto
also have "... = (1/lambda) * dist u v + 3/5 * C * (1/(lambda * lambda))"
using C by (auto simp add: algebra_simps divide_simps)
also have "... ≤ (1/lambda) * dist u v + 3/5 * C * 1"
apply (intro mono_intros)
using C by (auto simp add: divide_simps algebra_simps mult_ge1_powers(1))
also have "... ≤ (dist (d x) (d y) + 17/5 * C) + 3/5 * C * 1"
using * by auto
finally show ?thesis by auto
next
case 2
have "(1/lambda) * dist (next_in A u) v - C ≤ dist (c (next_in A u)) (c v)"
apply (rule quasi_isometry_onD(2)[OF assms(1)])
using ‹next_in A u ∈ A› ‹v ∈ A - {b}› ‹A ⊆ {a..b}› by auto
also have "... = dist (d (next_in A u)) (d v)"
using d by auto
also have "... ≤ dist (d (next_in A u)) (d x) + dist (d x) (d y) + dist (d y) (d v)"
by (intro mono_intros)
also have "... ≤ (2 * lambda * dist (next_in A u) x) + dist (d x) (d y) + (2 * lambda * dist y v)"
apply (intro mono_intros)
apply (rule lipschitz_onD[OF lip[OF u(1)]]) using u(2) apply auto[1] using u(2) apply auto[1]
apply (rule lipschitz_onD[OF lip[OF v(1)]]) using v(2) by auto
also have "... ≤ (2 * lambda * (2/5 * C/lambda)) + dist (d x) (d y) + (2 * lambda * (3/5 * C/lambda))"
apply (intro mono_intros)
unfolding dist_real_def using 2 u v C nu by auto
also have "... = 2 * C + dist (d x) (d y)"
using C by (auto simp add: algebra_simps divide_simps)
finally have *: "(1/lambda) * dist (next_in A u) v ≤ dist (d x) (d y) + 3 * C" by auto
have "(1/lambda) * dist x y ≤ (1/lambda) * (dist x (next_in A u) + dist (next_in A u) v + dist v y)"
apply (intro mono_intros)
unfolding dist_real_def using C u(2) v(2) ‹x < y› by auto
also have "... ≤ (1/lambda) * ((2/5 * C/lambda) + dist (next_in A u) v + (3/5 * C/lambda))"
apply (intro mono_intros)
unfolding dist_real_def using 2 u(2) v(2) C nu by auto
also have "... = (1/lambda) * dist (next_in A u) v + C * (1/(lambda * lambda))"
using C by (auto simp add: algebra_simps divide_simps)
also have "... ≤ (1/lambda) * dist (next_in A u) v + C * 1"
apply (intro mono_intros)
using C by (auto simp add: divide_simps algebra_simps mult_ge1_powers(1))
also have "... ≤ (dist (d x) (d y) + 3 * C) + C * 1"
using * by auto
finally show ?thesis by auto
next
case 3
have "(1/lambda) * dist u (next_in A v) - C ≤ dist (c u) (c (next_in A v))"
apply (rule quasi_isometry_onD(2)[OF assms(1)])
using ‹u ∈ A - {b}› ‹next_in A v ∈ A› ‹A ⊆ {a..b}› by auto
also have "... = dist (d u) (d (next_in A v))"
using d by auto
also have "... ≤ dist (d u) (d x) + dist (d x) (d y) + dist (d y) (d (next_in A v))"
by (intro mono_intros)
also have "... ≤ (2 * lambda * dist u x) + dist (d x) (d y) + (2 * lambda * dist y (next_in A v))"
apply (intro mono_intros)
apply (rule lipschitz_onD[OF lip[OF u(1)]]) using u(2) apply auto[1] using u(2) apply auto[1]
apply (rule lipschitz_onD[OF lip[OF v(1)]]) using v(2) by auto
also have "... ≤ (2 * lambda * (3/5 * C/lambda)) + dist (d x) (d y) + (2 * lambda * (9/10 * C/lambda))"
apply (intro mono_intros)
unfolding dist_real_def using 3 u v C nv by auto
also have "... = 3 * C + dist (d x) (d y)"
using C by (auto simp add: algebra_simps divide_simps)
finally have *: "(1/lambda) * dist u (next_in A v) ≤ dist (d x) (d y) + 4 * C" by auto
have "(1/lambda) * dist x y ≤ (1/lambda) * dist u (next_in A v)"
apply (intro mono_intros)
unfolding dist_real_def using C u(2) v(2) ‹x < y› by auto
also have "... ≤ dist (d x) (d y) + 4 * C"
using * by auto
finally show ?thesis by auto
next
case 4
have "(1/lambda) * dist (next_in A u) (next_in A v) - C ≤ dist (c (next_in A u)) (c (next_in A v))"
apply (rule quasi_isometry_onD(2)[OF assms(1)])
using ‹next_in A u ∈ A› ‹next_in A v ∈ A› ‹A ⊆ {a..b}› by auto
also have "... = dist (d (next_in A u)) (d (next_in A v))"
using d by auto
also have "... ≤ dist (d (next_in A u)) (d x) + dist (d x) (d y) + dist (d y) (d (next_in A v))"
by (intro mono_intros)
also have "... ≤ (2 * lambda * dist (next_in A u) x) + dist (d x) (d y) + (2 * lambda * dist y (next_in A v))"
apply (intro mono_intros)
apply (rule lipschitz_onD[OF lip[OF u(1)]]) using u(2) apply auto[1] using u(2) apply auto[1]
apply (rule lipschitz_onD[OF lip[OF v(1)]]) using v(2) by auto
also have "... ≤ (2 * lambda * (2/5 * C/lambda)) + dist (d x) (d y) + (2 * lambda * (9/10 * C/lambda))"
apply (intro mono_intros)
unfolding dist_real_def using 4 u v C nu nv by auto
also have "... = 13/5 * C + dist (d x) (d y)"
using C by (auto simp add: algebra_simps divide_simps)
finally have *: "(1/lambda) * dist (next_in A u) (next_in A v) ≤ dist (d x) (d y) + 18/5 * C" by auto
have "(1/lambda) * dist x y ≤ (1/lambda) * (dist x (next_in A u) + dist (next_in A u) (next_in A v))"
apply (intro mono_intros)
unfolding dist_real_def using C u(2) v(2) ‹x < y› by auto
also have "... ≤ (1/lambda) * ((2/5 *C/lambda) + dist (next_in A u) (next_in A v))"
apply (intro mono_intros)
unfolding dist_real_def using 4 u(2) v(2) C nu by auto
also have "... = (1/lambda) * dist (next_in A u) (next_in A v) + 2/5 * C * (1/(lambda * lambda))"
using C by (auto simp add: algebra_simps divide_simps)
also have "... ≤ (1/lambda) * dist (next_in A u) (next_in A v) + 2/5 * C * 1"
apply (intro mono_intros)
using C by (auto simp add: divide_simps algebra_simps mult_ge1_powers(1))
also have "... ≤ (dist (d x) (d y) + 18/5 * C) + 2/5 * C * 1"
using * by auto
finally show ?thesis by auto
qed
qed
qed
show "dist (d x) (d y) ≥ (1/lambda) * dist x y - 4 * C" if H: "x ∈ {a..b}" "y ∈ {a..b}" for x y
proof -
consider "x < y" | "x = y" | "x > y" by linarith
then show ?thesis
proof (cases)
case 1
then show ?thesis using J[OF H(1) H(2) 1] by simp
next
case 2
show ?thesis unfolding 2 using C by auto
next
case 3
show ?thesis using J[OF H(2) H(1) 3] by (simp add: metric_space_class.dist_commute)
qed
qed
qed
text ‹We have proved that $d$ has all the properties we wanted.›
then have "continuous_on {a..b} d ∧ d a = c a ∧ d b = c b
∧ lambda (4 * C)-quasi_isometry_on {a..b} d
∧ (∀x∈{a..b}. dist (c x) (d x) ≤ 4 *C)
∧ (2*lambda)-lipschitz_on {a..b} d
∧ hausdorff_distance (c`{a..b}) (d`{a..b}) ≤ 2 * C"
using dist_c_d ‹continuous_on {a..b} d› ‹d a = c a› ‹d b = c b› ‹(2*lambda)-lipschitz_on {a..b} d›
‹hausdorff_distance (c`{a..b}) (d`{a..b}) ≤ 2 * C› by auto
then show ?thesis by auto
qed
qed
end
Theory Metric_Completion
section ‹The metric completion of a metric space›
theory Metric_Completion
imports Isometries
begin
text ‹Any metric space can be completed, by adding the missing limits of Cauchy sequences.
Formally, there exists an isometric embedding of the space in a complete space, with dense image.
In this paragraph, we construct this metric completion. This is exactly the same construction
as the way in which real numbers are constructed from rational numbers.›
subsection ‹Definition of the metric completion›
quotient_type (overloaded) 'a metric_completion =
"nat ⇒ ('a::metric_space)" / partial: "λu v. (Cauchy u) ∧ (Cauchy v) ∧ (λn. dist (u n) (v n)) ⇢ 0"
unfolding part_equivp_def proof(auto intro!: ext)
show "∃x. Cauchy x"
by (rule exI[of _ "λ_. undefined"]) (simp add: convergent_Cauchy convergent_const)
fix x y z::"nat ⇒ 'a" assume H: "(λn. dist (x n) (y n)) ⇢ 0"
"(λn. dist (x n) (z n)) ⇢ 0"
have *: "(λn. dist (x n) (y n) + dist (x n) (z n)) ⇢ 0 + 0"
by (rule tendsto_add) (auto simp add: H)
show "(λn. dist (y n) (z n)) ⇢ 0"
apply (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. dist (x n) (y n) + dist (x n) (z n)"])
using * by (auto simp add: dist_triangle3)
next
fix x y z::"nat ⇒ 'a" assume H: "(λn. dist (x n) (y n)) ⇢ 0"
"(λn. dist (y n) (z n)) ⇢ 0"
have *: "(λn. dist (x n) (y n) + dist (y n) (z n)) ⇢ 0 + 0"
by (rule tendsto_add) (auto simp add: H)
show "(λn. dist (x n) (z n)) ⇢ 0"
apply (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. dist (x n) (y n) + dist (y n) (z n)"])
using * by (auto simp add: dist_triangle)
next
fix x y::"nat ⇒ 'a" assume H: "Cauchy x"
"(λv. Cauchy v ∧ (λn. dist (x n) (v n)) ⇢ 0) = (λv. Cauchy v ∧ (λn. dist (y n) (v n)) ⇢ 0)"
have "Cauchy x ∧ (λn. dist (x n) (x n)) ⇢ 0" using H by auto
then have "(λn. dist (y n) (x n))⇢ 0" using H by meson
moreover have "dist (x n) (y n) = dist (y n) (x n)" for n using dist_commute by auto
ultimately show "(λn. dist (x n) (y n)) ⇢ 0" by auto
qed
text ‹We have to show that the metric completion is indeed a metric space, that
the original space embeds isometrically into it, and that it is complete. Before we prove these
statements, we start with two simple lemmas that will be needed later on.›
lemma convergent_Cauchy_dist:
fixes u v::"nat ⇒ ('a::metric_space)"
assumes "Cauchy u" "Cauchy v"
shows "convergent (λn. dist (u n) (v n))"
proof (rule real_Cauchy_convergent, intro CauchyI)
fix e::real assume "e > 0"
obtain Nu where Nu: "∀n ≥ Nu. ∀m ≥ Nu. dist (u n) (u m) < e/2" using assms(1)
by (metis ‹0 < e› less_divide_eq_numeral1(1) metric_CauchyD mult_zero_left)
obtain Nv where Nv: "∀n ≥ Nv. ∀m ≥ Nv. dist (v n) (v m) < e/2" using assms(2)
by (metis ‹0 < e› less_divide_eq_numeral1(1) metric_CauchyD mult_zero_left)
define M where "M = max Nu Nv"
{
fix n m assume H: "n ≥ M" "m ≥ M"
have *: "dist (u n) (u m) < e/2" "dist (v n) (v m) < e/2"
using Nu Nv H unfolding M_def by auto
have "dist (u m) (v m) - dist (u n) (v n) ≤ dist (u m) (u n) + dist (v n) (v m)"
by (simp add: algebra_simps) (metis add_le_cancel_left dist_commute dist_triangle2 dist_triangle_le)
also have "... < e/2 + e/2"
using * by (simp add: dist_commute)
finally have A: "dist (u m) (v m) - dist (u n) (v n) < e" by simp
have "dist (u n) (v n) - dist (u m) (v m) ≤ dist (u m) (u n) + dist (v n) (v m)"
by (simp add: algebra_simps) (metis add_le_cancel_left dist_commute dist_triangle2 dist_triangle_le)
also have "... < e/2 + e/2"
using * by (simp add: dist_commute)
finally have "dist (u n) (v n) - dist (u m) (v m) < e" by simp
then have "norm(dist (u m) (v m) - dist (u n) (v n)) < e" using A by auto
}
then show "∃M. ∀m ≥ M. ∀n ≥ M. norm (dist (u m) (v m) - dist (u n) (v n)) < e"
by auto
qed
lemma convergent_add_null:
fixes u v::"nat ⇒ ('a::real_normed_vector)"
assumes "convergent u"
"(λn. v n - u n) ⇢ 0"
shows "convergent v" "lim v = lim u"
proof -
have "(λn. u n + (v n - u n)) ⇢ lim u + 0"
apply (rule tendsto_add) using assms convergent_LIMSEQ_iff by auto
then have *: "v ⇢ lim u" by auto
show "convergent v" using * by (simp add: Lim_def convergentI)
show "lim v = lim u" using * by (simp add: limI)
qed
text ‹Let us now prove that the metric completion is a metric space: the distance between two
Cauchy sequences is the limit of the distances of points in the sequence. The convergence follows
from Lemma~\verb+convergent_Cauchy_dist+ above.›
instantiation metric_completion :: (metric_space) metric_space
begin
lift_definition dist_metric_completion::"('a::metric_space) metric_completion ⇒ 'a metric_completion ⇒ real"
is "λx y. lim (λn. dist (x n) (y n))"
proof -
fix x y z t::"nat ⇒ 'a" assume H: "Cauchy x ∧ Cauchy y ∧ (λn. dist (x n) (y n)) ⇢ 0"
"Cauchy z ∧ Cauchy t ∧ (λn. dist (z n) (t n)) ⇢ 0"
show "lim (λn. dist (x n) (z n)) = lim (λn. dist (y n) (t n))"
proof (rule convergent_add_null(2))
show "convergent (λn. dist (y n) (t n))"
apply (rule convergent_Cauchy_dist) using H by auto
have a: "(λn. - dist (t n) (z n) - dist (x n) (y n)) ⇢ -0 -0"
apply (intro tendsto_intros) using H by (auto simp add: dist_commute)
have b:"(λn. dist (t n) (z n) + dist (x n) (y n)) ⇢ 0 + 0"
apply (rule tendsto_add) using H by (auto simp add: dist_commute)
have I: "dist (x n) (z n) ≤ dist (t n) (y n) + (dist (t n) (z n) + dist (x n) (y n))" for n
using dist_triangle[of "x n" "z n" "y n"] dist_triangle[of "y n" "z n" "t n"]
by (auto simp add: dist_commute add.commute)
show "(λn. dist (x n) (z n) - dist (y n) (t n)) ⇢ 0"
apply (rule tendsto_sandwich[of "λn. -(dist (x n) (y n) + dist (z n) (t n))" _ _ "λn. dist (x n) (y n) + dist (z n) (t n)"])
apply (auto intro!: always_eventually simp add: algebra_simps dist_commute I)
apply (meson add_left_mono dist_triangle3 dist_triangle_le)
using a b by auto
qed
qed
lemma dist_metric_completion_limit:
fixes x y::"'a metric_completion"
shows "(λn. dist (rep_metric_completion x n) (rep_metric_completion y n)) ⇢ dist x y"
proof -
have C: "Cauchy (rep_metric_completion x)" "Cauchy (rep_metric_completion y)"
using Quotient3_metric_completion Quotient3_rep_reflp by fastforce+
show ?thesis
unfolding dist_metric_completion_def using C apply auto
using convergent_Cauchy_dist[OF C] convergent_LIMSEQ_iff by force
qed
lemma dist_metric_completion_limit':
fixes x y::"nat ⇒ 'a"
assumes "Cauchy x" "Cauchy y"
shows "(λn. dist (x n) (y n)) ⇢ dist (abs_metric_completion x) (abs_metric_completion y)"
apply (subst dist_metric_completion.abs_eq)
using assms convergent_Cauchy_dist[OF assms] by (auto simp add: convergent_LIMSEQ_iff)
text ‹To define a metric space in the current library of Isabelle/HOL, one should also introduce
a uniformity structure and a topology, as follows (they are prescribed by the distance):›
definition uniformity_metric_completion::"(('a metric_completion) × ('a metric_completion)) filter"
where "uniformity_metric_completion = (INF e∈{0 <..}. principal {(x, y). dist x y < e})"
definition open_metric_completion :: "'a metric_completion set ⇒ bool"
where "open_metric_completion U = (∀x∈U. eventually (λ(x', y). x' = x ⟶ y ∈ U) uniformity)"
instance proof
fix x y::"'a metric_completion"
have C: "Cauchy (rep_metric_completion x)" "Cauchy (rep_metric_completion y)"
using Quotient3_metric_completion Quotient3_rep_reflp by fastforce+
show "(dist x y = 0) = (x = y)"
apply (subst Quotient3_rel_rep[OF Quotient3_metric_completion, symmetric])
unfolding dist_metric_completion_def using C apply auto
using convergent_Cauchy_dist[OF C] convergent_LIMSEQ_iff apply force
by (simp add: limI)
next
fix x y z::"'a metric_completion"
have a: "(λn. dist (rep_metric_completion x n) (rep_metric_completion y n)) ⇢ dist x y"
using dist_metric_completion_limit by auto
have b: "(λn. dist (rep_metric_completion x n) (rep_metric_completion z n) + dist (rep_metric_completion y n) (rep_metric_completion z n))
⇢ dist x z + dist y z"
apply (rule tendsto_add) using dist_metric_completion_limit by auto
show "dist x y ≤ dist x z + dist y z"
by (rule LIMSEQ_le[OF a b], rule exI[of _ 0], auto simp add: dist_triangle2)
qed (auto simp add: uniformity_metric_completion_def open_metric_completion_def)
end
text ‹Let us now show that the distance thus defined on the metric completion is indeed complete.
This is essentially by design.›
instance metric_completion :: (metric_space) complete_space
proof
fix X::"nat ⇒ 'a metric_completion" assume "Cauchy X"
have *: "∃N. ∀n ≥ N. dist (rep_metric_completion (X k) N) (rep_metric_completion (X k) n) < (1/Suc k)" for k
proof -
have "Cauchy (rep_metric_completion (X k))"
using Quotient3_metric_completion Quotient3_rep_reflp by fastforce+
then have "∃N. ∀m ≥ N. ∀n ≥ N. dist (rep_metric_completion (X k) m) (rep_metric_completion (X k) n) < (1/Suc k)"
unfolding Cauchy_def by auto
then show ?thesis by auto
qed
have "∃N. ∀k. ∀n ≥ N k. dist (rep_metric_completion (X k) (N k)) (rep_metric_completion (X k) n) < (1/Suc k)"
apply (rule choice) using * by auto
then obtain N::"nat ⇒ nat" where
N: "dist (rep_metric_completion (X k) (N k)) (rep_metric_completion (X k) n) < (1/Suc k)" if "n ≥ N k" for n k
by auto
define u where "u = (λk. rep_metric_completion (X k) (N k))"
have "Cauchy u"
proof (rule metric_CauchyI)
fix e::real assume "e > 0"
obtain K::nat where "K > 4/e" using reals_Archimedean2 by blast
obtain L::nat where L: "∀m ≥ L. ∀n ≥ L. dist (X m) (X n) < e/2"
using metric_CauchyD[OF ‹Cauchy X›, of "e/2"] ‹e > 0› by auto
{
fix m n assume "m ≥ max K L" "n ≥ max K L"
then have "dist (X m) (X n) < e/2" using L by auto
then have "eventually (λp. dist (rep_metric_completion (X m) p) (rep_metric_completion (X n) p) < e/2) sequentially"
using dist_metric_completion_limit[of "X m" "X n"] by (metis order_tendsto_iff)
then obtain p where p: "p ≥ max (N m) (N n)" "dist (rep_metric_completion (X m) p) (rep_metric_completion (X n) p) < e/2"
using eventually_False_sequentially eventually_elim2 eventually_ge_at_top by blast
have "dist (u m) (rep_metric_completion (X m) p) < 1 / real (Suc m)"
unfolding u_def using N[of m p] p(1) by auto
also have "... < e/4"
using ‹m ≥ max K L› ‹K > 4/e› ‹e > 0› apply (auto simp add: divide_simps algebra_simps)
by (metis leD le_less_trans less_add_same_cancel2 linear of_nat_le_iff mult_le_cancel_iff2)
finally have Im: "dist (u m) (rep_metric_completion (X m) p) < e/4" by simp
have "dist (u n) (rep_metric_completion (X n) p) < 1 / real (Suc n)"
unfolding u_def using N[of n p] p(1) by auto
also have "... < e/4"
using ‹n ≥ max K L› ‹K > 4/e› ‹e > 0› apply (auto simp add: divide_simps algebra_simps)
by (metis leD le_less_trans less_add_same_cancel2 linear of_nat_le_iff mult_le_cancel_iff2)
finally have In: "dist (u n) (rep_metric_completion (X n) p) < e/4" by simp
have "dist (u m) (u n) ≤ dist (u m) (rep_metric_completion (X m) p)
+ dist (rep_metric_completion (X m) p) (rep_metric_completion (X n) p) + dist (rep_metric_completion (X n) p) (u n)"
by (metis add.commute add_left_mono dist_commute dist_triangle_le dist_triangle)
also have "... < e/4 + e/2 + e/4"
using In Im p(2) by (simp add: dist_commute)
also have "... = e" by auto
finally have "dist (u m) (u n) < e" by auto
}
then show "∃M. ∀m ≥ M. ∀n ≥ M. dist (u m) (u n) < e" by meson
qed
have *: "(λn. dist (abs_metric_completion u) (X n)) ⇢ 0"
proof (rule order_tendstoI, auto simp add: less_le_trans eventually_sequentially)
fix e::real assume "e > 0"
obtain K::nat where "K > 4/e" using reals_Archimedean2 by blast
obtain L::nat where L: "∀m ≥ L. ∀n ≥ L. dist (u m) (u n) < e/4"
using metric_CauchyD[OF ‹Cauchy u›, of "e/4"] ‹e > 0› by auto
{
fix n assume n: "n ≥ max K L"
{
fix p assume p: "p ≥ max (N n) L"
have "dist (u n) (rep_metric_completion (X n) p) < 1/(Suc n)"
unfolding u_def using N p by simp
also have "... < e/4"
using ‹n ≥ max K L› ‹K > 4/e› ‹e > 0› apply (auto simp add: divide_simps algebra_simps)
by (metis leD le_less_trans less_add_same_cancel2 linear of_nat_le_iff mult_le_cancel_iff2)
finally have *: "dist (u n) (rep_metric_completion (X n) p) < e/4"
by fastforce
have "dist (u p) (rep_metric_completion (X n) p) ≤ dist (u p) (u n) + dist (u n) (rep_metric_completion (X n) p)"
using dist_triangle by auto
also have "... < e/4 + e/4" using * L n p by force
finally have "dist (u p) (rep_metric_completion (X n) p) ≤ e/2" by auto
}
then have A: "eventually (λp. dist (u p) (rep_metric_completion (X n) p) ≤ e/2) sequentially"
using eventually_at_top_linorder by blast
have B: "(λp. dist (u p) (rep_metric_completion (X n) p)) ⇢ dist (abs_metric_completion u) (X n)"
using dist_metric_completion_limit'[OF ‹Cauchy u›, of "rep_metric_completion (X n)"]
unfolding Quotient3_abs_rep[OF Quotient3_metric_completion, of "X n"]
using Quotient3_rep_reflp[OF Quotient3_metric_completion] by auto
have "dist (abs_metric_completion u) (X n) ≤ e/2"
apply (rule LIMSEQ_le_const2[OF B]) using A unfolding eventually_sequentially by auto
then have "dist (abs_metric_completion u) (X n) < e" using ‹e > 0› by auto
}
then show "∃N. ∀n ≥ N. dist (abs_metric_completion u) (X n) < e"
by blast
qed
have "X ⇢ abs_metric_completion u"
apply (rule tendstoI) using * by (auto simp add: order_tendsto_iff dist_commute)
then show "convergent X" unfolding convergent_def by auto
qed
subsection ‹Isometric embedding of a space in its metric completion›
text ‹The canonical embedding of a space into its metric completion is obtained by taking
the Cauchy sequence which is constant, equal to the given point. This is indeed an isometric
embedding with dense image, as we prove in the lemmas below.›
definition to_metric_completion::"('a::metric_space) ⇒ 'a metric_completion"
where "to_metric_completion x = abs_metric_completion (λn. x)"
lemma to_metric_completion_isometry:
"isometry_on UNIV to_metric_completion"
proof (rule isometry_onI)
fix x y::'a
have "(λn. dist (x) (y)) ⇢ dist (to_metric_completion x) (to_metric_completion y)"
unfolding to_metric_completion_def apply (rule dist_metric_completion_limit')
unfolding Cauchy_def by auto
then show "dist (to_metric_completion x) (to_metric_completion y) = dist x y"
by (simp add: LIMSEQ_const_iff)
qed
lemma to_metric_completion_dense:
assumes "open U" "U ≠ {}"
shows "∃x. to_metric_completion x ∈ U"
proof -
obtain y where "y ∈ U" using ‹U ≠ {}› by auto
obtain e::real where e: "e > 0" "⋀z. dist z y < e ⟹ z ∈ U"
using ‹y ∈ U› ‹open U› by (metis open_dist)
have *: "Cauchy (rep_metric_completion y)"
using Quotient3_metric_completion Quotient3_rep_reflp by fastforce
then obtain N where N: "∀n ≥ N. ∀m ≥ N. dist (rep_metric_completion y n) (rep_metric_completion y m) < e/2"
using ‹e > 0› unfolding Cauchy_def by (meson divide_pos_pos zero_less_numeral)
define x where "x = rep_metric_completion y N"
have "(λn. dist x (rep_metric_completion y n)) ⇢ dist (to_metric_completion x) (abs_metric_completion (rep_metric_completion y))"
unfolding to_metric_completion_def apply (rule dist_metric_completion_limit')
using * unfolding Cauchy_def by auto
then have "(λn. dist x (rep_metric_completion y n)) ⇢ dist (to_metric_completion x) y"
unfolding Quotient3_abs_rep[OF Quotient3_metric_completion] by simp
moreover have "eventually (λn. dist x (rep_metric_completion y n) ≤ e/2) sequentially"
unfolding eventually_sequentially x_def apply (rule exI[of _ N]) using N less_imp_le by auto
ultimately have "dist (to_metric_completion x) y ≤ e/2"
using LIMSEQ_le_const2 unfolding eventually_sequentially by metis
then have "to_metric_completion x ∈ U"
using e by auto
then show ?thesis by auto
qed
lemma to_metric_completion_dense':
"closure (range to_metric_completion) = UNIV"
apply (auto simp add: closure_iff_nhds_not_empty) using to_metric_completion_dense by fastforce
text ‹The main feature of the completion is that a uniformly continuous function on the original space can be extended
to a uniformly continuous function on the completion, i.e., it can be written as the composition of
a new function and of the inclusion \verb+to_metric_completion+.›
lemma lift_to_metric_completion:
fixes f::"('a::metric_space) ⇒ ('b::complete_space)"
assumes "uniformly_continuous_on UNIV f"
shows "∃g. (uniformly_continuous_on UNIV g)
∧ (f = g o to_metric_completion)
∧ (∀x ∈ range to_metric_completion. g x = f (inv to_metric_completion x))"
proof -
define I::"'a metric_completion ⇒ 'a" where "I = inv to_metric_completion"
have "uniformly_continuous_on (range to_metric_completion) I"
using isometry_on_uniformly_continuous[OF isometry_on_inverse(1)[OF to_metric_completion_isometry]] I_def
by auto
then have UC: "uniformly_continuous_on (range to_metric_completion) (λx. f (I x))"
using assms uniformly_continuous_on_compose
by (metis I_def bij_betw_imp_surj_on bij_betw_inv_into isometry_on_inverse(4) to_metric_completion_isometry)
obtain g where g: "uniformly_continuous_on (closure(range to_metric_completion)) g"
"⋀x. x ∈ range to_metric_completion ⟹ f (I x) = g x"
using uniformly_continuous_on_extension_on_closure[OF UC] by metis
have "uniformly_continuous_on UNIV g"
using to_metric_completion_dense' g(1) by metis
moreover have "f x = g (to_metric_completion x)" for x
using g(2) by (metis I_def UNIV_I isometry_on_inverse(2) range_eqI to_metric_completion_isometry)
moreover have "g x = f (inv to_metric_completion x)" if "x ∈ range to_metric_completion" for x
using I_def g(2) that by auto
ultimately show ?thesis unfolding comp_def by auto
qed
text ‹When the function is an isometry, the lifted function is also an isometry (and its range is
the closure of the range of the original function).
This shows that the metric completion is unique, up to isometry:›
lemma lift_to_metric_completion_isometry:
fixes f::"('a::metric_space) ⇒ ('b::complete_space)"
assumes "isometry_on UNIV f"
shows "∃g. isometry_on UNIV g
∧ range g = closure(range f)
∧ f = g o to_metric_completion
∧ (∀x ∈ range to_metric_completion. g x = f (inv to_metric_completion x))"
proof -
have *: "uniformly_continuous_on UNIV f" using assms isometry_on_uniformly_continuous by force
obtain g where g: "uniformly_continuous_on UNIV g"
"f = g o to_metric_completion"
"⋀x. x ∈ range to_metric_completion ⟹ g x = f (inv to_metric_completion x)"
using lift_to_metric_completion[OF *] by blast
have *: "isometry_on (range to_metric_completion) g"
apply (rule isometry_on_cong[OF _ g(3)], rule isometry_on_compose[of _ _ f])
using assms isometry_on_inverse[OF to_metric_completion_isometry] isometry_on_subset by (auto) (fastforce)
then have "isometry_on UNIV g"
unfolding to_metric_completion_dense'[symmetric] apply (rule isometry_on_closure)
using continuous_on_subset[OF uniformly_continuous_imp_continuous[OF g(1)]] by auto
have "g`(range to_metric_completion) ⊆ range f"
using g unfolding comp_def by auto
moreover have "g`(closure (range to_metric_completion)) ⊆ closure (g`(range to_metric_completion))"
using uniformly_continuous_imp_continuous[OF g(1)]
by (meson closed_closure closure_subset continuous_on_subset image_closure_subset top_greatest)
ultimately have "range g ⊆ closure (range f)"
unfolding to_metric_completion_dense' by (simp add: g(2) image_comp)
have "range f ⊆ range g"
using g(2) by auto
moreover have "closed (range g)"
using isometry_on_complete_image[OF ‹isometry_on UNIV g›] by (simp add: complete_eq_closed)
ultimately have "closure (range f) ⊆ range g"
by (simp add: closure_minimal)
then have "range g = closure (range f)"
using ‹range g ⊆ closure (range f)› by auto
then show ?thesis using ‹isometry_on UNIV g› g by metis
qed
subsection ‹The metric completion of a second countable space is second countable›
text ‹We want to show that the metric completion of a second countable space is still
second countable. This is most easily expressed using the fact that a metric
space is second countable if and only if there exists a dense countable subset. We prove
the equivalence in the next lemma, and use it then to prove that the metric completion is
still second countable.›
lemma second_countable_iff_dense_countable_subset:
"(∃B::'a::metric_space set set. countable B ∧ topological_basis B)
⟷ (∃A::'a set. countable A ∧ closure A = UNIV)"
proof
assume "∃B::'a set set. countable B ∧ topological_basis B"
then obtain B::"'a set set" where "countable B" "topological_basis B" by auto
define A where "A = (λU. SOME x. x ∈ U)`B"
have "countable A" unfolding A_def using ‹countable B› by auto
moreover have "closure A = UNIV"
proof (auto simp add: closure_approachable)
fix x::'a and e::real assume "e > 0"
obtain U where "U ∈ B" "x ∈ U" "U ⊆ ball x e"
by (rule topological_basisE[OF ‹topological_basis B›, of "ball x e" x], auto simp add: ‹e > 0›)
define y where "y = (λU. SOME x. x ∈ U) U"
have "y ∈ U" unfolding y_def using ‹x ∈ U› some_in_eq by fastforce
then have "dist y x < e"
using ‹U ⊆ ball x e› by (metis dist_commute mem_ball subset_iff)
moreover have "y ∈ A" unfolding A_def y_def using ‹U ∈ B› by auto
ultimately show "∃y∈A. dist y x < e" by auto
qed
ultimately show "∃A::'a set. countable A ∧ closure A = UNIV" by auto
next
assume "∃A::'a set. countable A ∧ closure A = UNIV"
then obtain A::"'a set" where "countable A" "closure A = UNIV" by auto
define B where "B = (λ(x, (n::nat)). ball x (1/n))`(A × UNIV)"
have "countable B" unfolding B_def using ‹countable A› by auto
moreover have "topological_basis B"
proof (rule topological_basisI)
fix x::'a and U assume "x ∈ U" "open U"
then obtain e where "e > 0" "ball x e ⊆ U"
using openE by blast
obtain n::nat where "n > 2/e" using reals_Archimedean2 by auto
then have "n > 0" using ‹e > 0› not_less by fastforce
then have "1/n > 0" using zero_less_divide_iff by fastforce
then obtain y where y: "y ∈ A" "dist x y < 1/n"
by (metis ‹closure A = UNIV› UNIV_I closure_approachable dist_commute)
then have "ball y (1/n) ∈ B" unfolding B_def by auto
moreover have "x ∈ ball y (1/n)" using y(2) by (auto simp add: dist_commute)
moreover have "ball y (1/n) ⊆ U"
proof (auto)
fix z assume z: "dist y z < 1/n"
have "dist z x ≤ dist z y + dist y x" using dist_triangle by auto
also have "... < 1/n + 1/n" using z y(2) by (auto simp add: dist_commute)
also have "... < e"
using ‹n > 2/e› ‹e > 0› ‹n > 0› by (auto simp add: divide_simps mult.commute)
finally have "z ∈ ball x e" by (auto simp add: dist_commute)
then show "z ∈ U" using ‹ball x e ⊆ U› by auto
qed
ultimately show "∃V∈B. x ∈ V ∧ V ⊆ U" by metis
qed (auto simp add: B_def)
ultimately show "∃B::'a set set. countable B ∧ topological_basis B" by auto
qed
lemma second_countable_metric_dense_subset:
"∃A::'a::{metric_space, second_countable_topology} set. countable A ∧ closure A = UNIV"
using ex_countable_basis by (auto simp add: second_countable_iff_dense_countable_subset[symmetric])
instance metric_completion::("{metric_space, second_countable_topology}") second_countable_topology
proof
obtain A::"'a set" where "countable A" "closure A = UNIV"
using second_countable_metric_dense_subset by auto
define Ab where "Ab = to_metric_completion`A"
have "range to_metric_completion ⊆ closure Ab"
unfolding Ab_def
by (metis ‹closure A = UNIV› isometry_on_continuous[OF to_metric_completion_isometry] closed_closure closure_subset image_closure_subset)
then have "closure Ab = UNIV"
by (metis (no_types) to_metric_completion_dense'[symmetric] ‹range to_metric_completion ⊆ closure Ab› closure_closure closure_mono top.extremum_uniqueI)
moreover have "countable Ab" unfolding Ab_def using ‹countable A› by auto
ultimately have "∃Ab::'a metric_completion set. countable Ab ∧ closure Ab = UNIV"
by auto
then show "∃B::'a metric_completion set set. countable B ∧ open = generate_topology B"
using second_countable_iff_dense_countable_subset topological_basis_imp_subbasis by auto
qed
instance metric_completion::("{metric_space, second_countable_topology}") polish_space
by standard
end
Theory Gromov_Hyperbolicity
section ‹Gromov hyperbolic spaces›
theory Gromov_Hyperbolicity
imports Isometries Metric_Completion
begin
subsection ‹Definition, basic properties›
text ‹Although we will mainly work with type classes later on, we introduce the definition
of hyperbolicity on subsets of a metric space.
A set is $\delta$-hyperbolic if it satisfies the following inequality. It is very obscure at first sight,
but we will see several equivalent characterizations later on. For instance, a space is hyperbolic
(maybe for a different constant $\delta$) if all geodesic triangles are thin, i.e., every side is
close to the union of the two other sides. This definition captures the main features of negative
curvature at a large scale, and has proved extremely fruitful and influential.
Two important references on this topic are~\cite{ghys_hyperbolique} and~\cite{bridson_haefliger}.
We will sometimes follow them, sometimes depart from them.›
definition Gromov_hyperbolic_subset::"real ⇒ ('a::metric_space) set ⇒ bool"
where "Gromov_hyperbolic_subset delta A = (∀x∈A. ∀y∈A. ∀z∈A. ∀t∈A. dist x y + dist z t ≤ max (dist x z + dist y t) (dist x t + dist y z) + 2 * delta)"
lemma Gromov_hyperbolic_subsetI [intro]:
assumes "⋀x y z t. x ∈ A ⟹ y ∈ A ⟹ z ∈ A ⟹ t ∈ A ⟹ dist x y + dist z t ≤ max (dist x z + dist y t) (dist x t + dist y z) + 2 * delta"
shows "Gromov_hyperbolic_subset delta A"
using assms unfolding Gromov_hyperbolic_subset_def by auto
text ‹When the four points are not all distinct, the above inequality is always satisfied for
$\delta = 0$.›
lemma Gromov_hyperbolic_ineq_not_distinct:
assumes "x = y ∨ x = z ∨ x = t ∨ y = z ∨ y = t ∨ z = (t::'a::metric_space)"
shows "dist x y + dist z t ≤ max (dist x z + dist y t) (dist x t + dist y z)"
using assms by (auto simp add: dist_commute, simp add: dist_triangle add.commute, simp add: dist_triangle3)
text ‹It readily follows from the definition that hyperbolicity passes to the closure of the set.›
lemma Gromov_hyperbolic_closure:
assumes "Gromov_hyperbolic_subset delta A"
shows "Gromov_hyperbolic_subset delta (closure A)"
unfolding Gromov_hyperbolic_subset_def proof (auto)
fix x y z t assume H: "x ∈ closure A" "y ∈ closure A" "z ∈ closure A" "t ∈ closure A"
obtain X::"nat ⇒ 'a" where X: "⋀n. X n ∈ A" "X ⇢ x"
using H closure_sequential by blast
obtain Y::"nat ⇒ 'a" where Y: "⋀n. Y n ∈ A" "Y ⇢ y"
using H closure_sequential by blast
obtain Z::"nat ⇒ 'a" where Z: "⋀n. Z n ∈ A" "Z ⇢ z"
using H closure_sequential by blast
obtain T::"nat ⇒ 'a" where T: "⋀n. T n ∈ A" "T ⇢ t"
using H closure_sequential by blast
have *: "max (dist (X n) (Z n) + dist (Y n) (T n)) (dist (X n) (T n) + dist (Y n) (Z n)) + 2 * delta - dist (X n) (Y n) - dist (Z n) (T n) ≥ 0" for n
using assms X(1)[of n] Y(1)[of n] Z(1)[of n] T(1)[of n] unfolding Gromov_hyperbolic_subset_def
by (auto simp add: algebra_simps)
have **: "(λn. max (dist (X n) (Z n) + dist (Y n) (T n)) (dist (X n) (T n) + dist (Y n) (Z n)) + 2 * delta - dist (X n) (Y n) - dist (Z n) (T n))
⇢ max (dist x z + dist y t) (dist x t + dist y z) + 2 * delta - dist x y - dist z t"
apply (auto intro!: tendsto_intros) using X Y Z T by auto
have "max (dist x z + dist y t) (dist x t + dist y z) + 2 * delta - dist x y - dist z t ≥ 0"
apply (rule LIMSEQ_le_const[OF **]) using * by auto
then show "dist x y + dist z t ≤ max (dist x z + dist y t) (dist x t + dist y z) + 2 * delta"
by auto
qed
text ‹A good formulation of hyperbolicity is in terms of Gromov products. Intuitively, the
Gromov product of $x$ and $y$ based at $e$ is the distance between $e$ and the geodesic between
$x$ and $y$. It is also the time after which the geodesics from $e$ to $x$ and from $e$ to $y$
stop travelling together.›
definition Gromov_product_at::"('a::metric_space) ⇒ 'a ⇒ 'a ⇒ real"
where "Gromov_product_at e x y = (dist e x + dist e y - dist x y) / 2"
lemma Gromov_hyperbolic_subsetI2:
fixes delta::real
assumes "⋀e x y z. e ∈ A ⟹ x ∈ A ⟹ y ∈ A ⟹ z ∈ A ⟹ Gromov_product_at (e::'a::metric_space) x z ≥ min (Gromov_product_at e x y) (Gromov_product_at e y z) - delta"
shows "Gromov_hyperbolic_subset delta A"
proof (rule Gromov_hyperbolic_subsetI)
fix x y z t assume H: "x ∈ A" "z ∈ A" "y ∈ A" "t ∈ A"
show "dist x y + dist z t ≤ max (dist x z + dist y t) (dist x t + dist y z) + 2 * delta"
using assms[OF H] unfolding Gromov_product_at_def min_def max_def
by (auto simp add: divide_simps algebra_simps dist_commute)
qed
lemma Gromov_product_nonneg [simp, mono_intros]:
"Gromov_product_at e x y ≥ 0"
unfolding Gromov_product_at_def by (simp add: dist_triangle3)
lemma Gromov_product_commute:
"Gromov_product_at e x y = Gromov_product_at e y x"
unfolding Gromov_product_at_def by (auto simp add: dist_commute)
lemma Gromov_product_le_dist [simp, mono_intros]:
"Gromov_product_at e x y ≤ dist e x"
"Gromov_product_at e x y ≤ dist e y"
unfolding Gromov_product_at_def by (auto simp add: diff_le_eq dist_triangle dist_triangle2)
lemma Gromov_product_le_infdist [mono_intros]:
assumes "geodesic_segment_between G x y"
shows "Gromov_product_at e x y ≤ infdist e G"
proof -
have [simp]: "G ≠ {}" using assms by auto
have "Gromov_product_at e x y ≤ dist e z" if "z ∈ G" for z
proof -
have "dist e x + dist e y ≤ (dist e z + dist z x) + (dist e z + dist z y)"
by (intro add_mono dist_triangle)
also have "... = 2 * dist e z + dist x y"
apply (auto simp add: dist_commute) using ‹z ∈ G› assms by (metis dist_commute geodesic_segment_dist)
finally show ?thesis unfolding Gromov_product_at_def by auto
qed
then show ?thesis
apply (subst infdist_notempty) by (auto intro: cINF_greatest)
qed
lemma Gromov_product_add:
"Gromov_product_at e x y + Gromov_product_at x e y = dist e x"
unfolding Gromov_product_at_def by (auto simp add: algebra_simps divide_simps dist_commute)
lemma Gromov_product_geodesic_segment:
assumes "geodesic_segment_between G x y" "t ∈ {0..dist x y}"
shows "Gromov_product_at x y (geodesic_segment_param G x t) = t"
proof -
have "dist x (geodesic_segment_param G x t) = t"
using assms(1) assms(2) geodesic_segment_param(6) by auto
moreover have "dist y (geodesic_segment_param G x t) = dist x y - t"
by (metis ‹dist x (geodesic_segment_param G x t) = t› add_diff_cancel_left' assms(1) assms(2) dist_commute geodesic_segment_dist geodesic_segment_param(3))
ultimately show ?thesis unfolding Gromov_product_at_def by auto
qed
lemma Gromov_product_e_x_x [simp]:
"Gromov_product_at e x x = dist e x"
unfolding Gromov_product_at_def by auto
lemma Gromov_product_at_diff:
"¦Gromov_product_at x y z - Gromov_product_at a b c¦ ≤ dist x a + dist y b + dist z c"
unfolding Gromov_product_at_def abs_le_iff apply (auto simp add: divide_simps)
by (smt dist_commute dist_triangle4)+
lemma Gromov_product_at_diff1:
"¦Gromov_product_at a x y - Gromov_product_at b x y¦ ≤ dist a b"
using Gromov_product_at_diff[of a x y b x y] by auto
lemma Gromov_product_at_diff2:
"¦Gromov_product_at e x z - Gromov_product_at e y z¦ ≤ dist x y"
using Gromov_product_at_diff[of e x z e y z] by auto
lemma Gromov_product_at_diff3:
"¦Gromov_product_at e x y - Gromov_product_at e x z¦ ≤ dist y z"
using Gromov_product_at_diff[of e x y e x z] by auto
text ‹The Gromov product is continuous in its three variables. We formulate it in terms of sequences,
as it is the way it will be used below (and moreover continuity for functions of several variables
is very poor in the library).›
lemma Gromov_product_at_continuous:
assumes "(u ⤏ x) F" "(v ⤏ y) F" "(w ⤏ z) F"
shows "((λn. Gromov_product_at (u n) (v n) (w n)) ⤏ Gromov_product_at x y z) F"
proof -
have "((λn. abs(Gromov_product_at (u n) (v n) (w n) - Gromov_product_at x y z)) ⤏ 0 + 0 + 0) F"
apply (rule tendsto_sandwich[of "λn. 0" _ _ "λn. dist (u n) x + dist (v n) y + dist (w n) z", OF always_eventually always_eventually])
apply (simp, simp add: Gromov_product_at_diff, simp, intro tendsto_intros)
using assms tendsto_dist_iff by auto
then show ?thesis
apply (subst tendsto_dist_iff) unfolding dist_real_def by auto
qed
subsection ‹Typeclass for Gromov hyperbolic spaces›
text ‹We could (should?) just derive \verb+Gromov_hyperbolic_space+ from \verb+metric_space+.
However, in this case, properties of metric spaces are not available when working in the locale!
It is more efficient to ensure that we have a metric space by putting a type class restriction
in the definition. The $\delta$ in Gromov-hyperbolicity type class is called \verb+deltaG+ to
avoid name clashes.
›
class metric_space_with_deltaG = metric_space +
fixes deltaG::"('a::metric_space) itself ⇒ real"
class Gromov_hyperbolic_space = metric_space_with_deltaG +
assumes hyperb_quad_ineq0: "Gromov_hyperbolic_subset (deltaG(TYPE('a::metric_space))) (UNIV::'a set)"
class Gromov_hyperbolic_space_geodesic = Gromov_hyperbolic_space + geodesic_space
lemma (in Gromov_hyperbolic_space) hyperb_quad_ineq [mono_intros]:
shows "dist x y + dist z t ≤ max (dist x z + dist y t) (dist x t + dist y z) + 2 * deltaG(TYPE('a))"
using hyperb_quad_ineq0 unfolding Gromov_hyperbolic_subset_def by auto
text ‹It readily follows from the definition that the completion of a $\delta$-hyperbolic
space is still $\delta$-hyperbolic.›
instantiation metric_completion :: (Gromov_hyperbolic_space) Gromov_hyperbolic_space
begin
definition deltaG_metric_completion::"('a metric_completion) itself ⇒ real" where
"deltaG_metric_completion _ = deltaG(TYPE('a))"
instance proof (standard, rule Gromov_hyperbolic_subsetI)
have "Gromov_hyperbolic_subset (deltaG(TYPE('a))) (range (to_metric_completion::'a ⇒ _))"
unfolding Gromov_hyperbolic_subset_def
apply (auto simp add: isometry_onD[OF to_metric_completion_isometry])
by (metis hyperb_quad_ineq)
then have "Gromov_hyperbolic_subset (deltaG TYPE('a metric_completion)) (UNIV::'a metric_completion set)"
unfolding deltaG_metric_completion_def to_metric_completion_dense'[symmetric]
using Gromov_hyperbolic_closure by auto
then show "dist x y + dist z t ≤ max (dist x z + dist y t) (dist x t + dist y z) + 2 * deltaG TYPE('a metric_completion)"
for x y z t::"'a metric_completion"
unfolding Gromov_hyperbolic_subset_def by auto
qed
end
context Gromov_hyperbolic_space
begin
lemma delta_nonneg [simp, mono_intros]:
"deltaG(TYPE('a)) ≥ 0"
proof -
obtain x::'a where True by auto
show ?thesis using hyperb_quad_ineq[of x x x x] by auto
qed
lemma hyperb_ineq [mono_intros]:
"Gromov_product_at (e::'a) x z ≥ min (Gromov_product_at e x y) (Gromov_product_at e y z) - deltaG(TYPE('a))"
using hyperb_quad_ineq[of e y x z] unfolding Gromov_product_at_def min_def max_def
by (auto simp add: divide_simps algebra_simps metric_space_class.dist_commute)
lemma hyperb_ineq' [mono_intros]:
"Gromov_product_at (e::'a) x z + deltaG(TYPE('a)) ≥ min (Gromov_product_at e x y) (Gromov_product_at e y z)"
using hyperb_ineq[of e x y z] by auto
lemma hyperb_ineq_4_points [mono_intros]:
"Min {Gromov_product_at (e::'a) x y, Gromov_product_at e y z, Gromov_product_at e z t} - 2 * deltaG(TYPE('a)) ≤ Gromov_product_at e x t"
using hyperb_ineq[of e x y z] hyperb_ineq[of e x z t] apply auto using delta_nonneg by linarith
lemma hyperb_ineq_4_points' [mono_intros]:
"Min {Gromov_product_at (e::'a) x y, Gromov_product_at e y z, Gromov_product_at e z t} ≤ Gromov_product_at e x t + 2 * deltaG(TYPE('a))"
using hyperb_ineq_4_points[of e x y z t] by auto
text ‹In Gromov-hyperbolic spaces, geodesic triangles are thin, i.e., a point on one side of a
geodesic triangle is close to the union of the two other sides (where the constant in "close"
is $4\delta$, independent of the size of the triangle). We prove this basic property
(which, in fact, is a characterization of Gromov-hyperbolic spaces: a geodesic space in which
triangles are thin is hyperbolic).›
lemma thin_triangles1:
assumes "geodesic_segment_between G x y" "geodesic_segment_between H x (z::'a)"
"t ∈ {0..Gromov_product_at x y z}"
shows "dist (geodesic_segment_param G x t) (geodesic_segment_param H x t) ≤ 4 * deltaG(TYPE('a))"
proof -
have *: "Gromov_product_at x z (geodesic_segment_param H x t) = t"
apply (rule Gromov_product_geodesic_segment[OF assms(2)]) using assms(3) Gromov_product_le_dist(2)
by (metis atLeastatMost_subset_iff subset_iff)
have "Gromov_product_at x y (geodesic_segment_param H x t)
≥ min (Gromov_product_at x y z) (Gromov_product_at x z (geodesic_segment_param H x t)) - deltaG(TYPE('a))"
by (rule hyperb_ineq)
then have I: "Gromov_product_at x y (geodesic_segment_param H x t) ≥ t - deltaG(TYPE('a))"
using assms(3) unfolding * by auto
have *: "Gromov_product_at x (geodesic_segment_param G x t) y = t"
apply (subst Gromov_product_commute)
apply (rule Gromov_product_geodesic_segment[OF assms(1)]) using assms(3) Gromov_product_le_dist(1)
by (metis atLeastatMost_subset_iff subset_iff)
have "t - 2 * deltaG(TYPE('a)) = min t (t- deltaG(TYPE('a))) - deltaG(TYPE('a))"
unfolding min_def using antisym by fastforce
also have "... ≤ min (Gromov_product_at x (geodesic_segment_param G x t) y) (Gromov_product_at x y (geodesic_segment_param H x t)) - deltaG(TYPE('a))"
using I * by auto
also have "... ≤ Gromov_product_at x (geodesic_segment_param G x t) (geodesic_segment_param H x t)"
by (rule hyperb_ineq)
finally have I: "Gromov_product_at x (geodesic_segment_param G x t) (geodesic_segment_param H x t) ≥ t - 2 * deltaG(TYPE('a))"
by simp
have A: "dist x (geodesic_segment_param G x t) = t"
by (meson assms(1) assms(3) atLeastatMost_subset_iff geodesic_segment_param(6) Gromov_product_le_dist(1) subset_eq)
have B: "dist x (geodesic_segment_param H x t) = t"
by (meson assms(2) assms(3) atLeastatMost_subset_iff geodesic_segment_param(6) Gromov_product_le_dist(2) subset_eq)
show ?thesis
using I unfolding Gromov_product_at_def A B by auto
qed
theorem thin_triangles:
assumes "geodesic_segment_between Gxy x y"
"geodesic_segment_between Gxz x z"
"geodesic_segment_between Gyz y z"
"(w::'a) ∈ Gyz"
shows "infdist w (Gxy ∪ Gxz) ≤ 4 * deltaG(TYPE('a))"
proof -
obtain t where w: "t ∈ {0..dist y z}" "w = geodesic_segment_param Gyz y t"
using geodesic_segment_param[OF assms(3)] assms(4) by (metis imageE)
show ?thesis
proof (cases "t ≤ Gromov_product_at y x z")
case True
have *: "dist w (geodesic_segment_param Gxy y t) ≤ 4 * deltaG(TYPE('a))" unfolding w(2)
apply (rule thin_triangles1[of _ _ z _ x])
using True assms(1) assms(3) w(1) by (auto simp add: geodesic_segment_commute Gromov_product_commute)
show ?thesis
apply (rule infdist_le2[OF _ *])
by (metis True assms(1) box_real(2) geodesic_segment_commute geodesic_segment_param(3) Gromov_product_le_dist(1) mem_box_real(2) order_trans subset_eq sup.cobounded1 w(1))
next
case False
define s where "s = dist y z - t"
have s: "s ∈ {0..Gromov_product_at z y x}"
unfolding s_def using Gromov_product_add[of y z x] w(1) False by (auto simp add: Gromov_product_commute)
have w2: "w = geodesic_segment_param Gyz z s"
unfolding s_def w(2) apply (rule geodesic_segment_reverse_param[symmetric]) using assms(3) w(1) by auto
have *: "dist w (geodesic_segment_param Gxz z s) ≤ 4 * deltaG(TYPE('a))" unfolding w2
apply (rule thin_triangles1[of _ _ y _ x])
using s assms by (auto simp add: geodesic_segment_commute)
show ?thesis
apply (rule infdist_le2[OF _ *])
by (metis Un_iff assms(2) atLeastAtMost_iff geodesic_segment_commute geodesic_segment_param(3) Gromov_product_commute Gromov_product_le_dist(1) order_trans s)
qed
qed
text ‹A consequence of the thin triangles property is that, although the geodesic between
two points is in general not unique in a Gromov-hyperbolic space, two such geodesics are
within $O(\delta)$ of each other.›
lemma geodesics_nearby:
assumes "geodesic_segment_between G x y" "geodesic_segment_between H x y"
"(z::'a) ∈ G"
shows "infdist z H ≤ 4 * deltaG(TYPE('a))"
using thin_triangles[OF geodesic_segment_between_x_x(1) assms(2) assms(1) assms(3)]
geodesic_segment_endpoints(1)[OF assms(2)] insert_absorb by fastforce
text ‹A small variant of the property of thin triangles is that triangles are slim, i.e., there is
a point which is close to the three sides of the triangle (a "center" of the triangle, but
only defined up to $O(\delta)$). And one can take it on any side, and its distance to the corresponding
vertices is expressed in terms of a Gromov product.›
lemma slim_triangle:
assumes "geodesic_segment_between Gxy x y"
"geodesic_segment_between Gxz x z"
"geodesic_segment_between Gyz y (z::'a)"
shows "∃w. infdist w Gxy ≤ 4 * deltaG(TYPE('a)) ∧
infdist w Gxz ≤ 4 * deltaG(TYPE('a)) ∧
infdist w Gyz ≤ 4 * deltaG(TYPE('a)) ∧
dist w x = (Gromov_product_at x y z) ∧ w ∈ Gxy"
proof -
define w where "w = geodesic_segment_param Gxy x (Gromov_product_at x y z)"
have "w ∈ Gxy" unfolding w_def
by (rule geodesic_segment_param(3)[OF assms(1)], auto)
then have xy: "infdist w Gxy ≤ 4 * deltaG(TYPE('a))" by simp
have *: "dist w x = (Gromov_product_at x y z)"
unfolding w_def using assms(1)
by (metis Gromov_product_le_dist(1) Gromov_product_nonneg atLeastAtMost_iff geodesic_segment_param(6) metric_space_class.dist_commute)
define w2 where "w2 = geodesic_segment_param Gxz x (Gromov_product_at x y z)"
have "w2 ∈ Gxz" unfolding w2_def
by (rule geodesic_segment_param(3)[OF assms(2)], auto)
moreover have "dist w w2 ≤ 4 * deltaG(TYPE('a))"
unfolding w_def w2_def by (rule thin_triangles1[OF assms(1) assms(2)], auto)
ultimately have xz: "infdist w Gxz ≤ 4 * deltaG(TYPE('a))"
using infdist_le2 by blast
have "w = geodesic_segment_param Gxy y (dist x y - Gromov_product_at x y z)"
unfolding w_def by (rule geodesic_segment_reverse_param[OF assms(1), symmetric], auto)
then have w: "w = geodesic_segment_param Gxy y (Gromov_product_at y x z)"
using Gromov_product_add[of x y z] by (metis add_diff_cancel_left')
define w3 where "w3 = geodesic_segment_param Gyz y (Gromov_product_at y x z)"
have "w3 ∈ Gyz" unfolding w3_def
by (rule geodesic_segment_param(3)[OF assms(3)], auto)
moreover have "dist w w3 ≤ 4 * deltaG(TYPE('a))"
unfolding w w3_def by (rule thin_triangles1[OF geodesic_segment_commute[OF assms(1)] assms(3)], auto)
ultimately have yz: "infdist w Gyz ≤ 4 * deltaG(TYPE('a))"
using infdist_le2 by blast
show ?thesis using xy xz yz * ‹w ∈ Gxy› by force
qed
text ‹The distance of a vertex of a triangle to the opposite side is essentially given by the
Gromov product, up to $2\delta$.›
lemma dist_triangle_side_middle:
assumes "geodesic_segment_between G x (y::'a)"
shows "dist z (geodesic_segment_param G x (Gromov_product_at x z y)) ≤ Gromov_product_at z x y + 2 * deltaG(TYPE('a))"
proof -
define m where "m = geodesic_segment_param G x (Gromov_product_at x z y)"
have "m ∈ G"
unfolding m_def using assms(1) by auto
have A: "dist x m = Gromov_product_at x z y"
unfolding m_def by (rule geodesic_segment_param(6)[OF assms(1)], auto)
have B: "dist y m = dist x y - dist x m"
using geodesic_segment_dist[OF assms ‹m ∈ G›] by (auto simp add: metric_space_class.dist_commute)
have *: "dist x z + dist y m = Gromov_product_at z x y + dist x y"
"dist x m + dist y z = Gromov_product_at z x y + dist x y"
unfolding B A Gromov_product_at_def by (auto simp add: metric_space_class.dist_commute divide_simps)
have "dist x y + dist z m ≤ max (dist x z + dist y m) (dist x m + dist y z) + 2 * deltaG(TYPE('a))"
by (rule hyperb_quad_ineq)
then have "dist z m ≤ Gromov_product_at z x y + 2 * deltaG(TYPE('a))"
unfolding * by auto
then show ?thesis
unfolding m_def by auto
qed
lemma infdist_triangle_side [mono_intros]:
assumes "geodesic_segment_between G x (y::'a)"
shows "infdist z G ≤ Gromov_product_at z x y + 2 * deltaG(TYPE('a))"
proof -
have "infdist z G ≤ dist z (geodesic_segment_param G x (Gromov_product_at x z y))"
using assms by (auto intro!: infdist_le)
then show ?thesis
using dist_triangle_side_middle[OF assms, of z] by auto
qed
text ‹The distance of a point on a side of triangle to the opposite vertex is controlled by
the length of the opposite sides, up to $\delta$.›
lemma dist_le_max_dist_triangle:
assumes "geodesic_segment_between G x y"
"m ∈ G"
shows "dist m z ≤ max (dist x z) (dist y z) + deltaG(TYPE('a))"
proof -
consider "dist m x ≤ deltaG(TYPE('a))" | "dist m y ≤ deltaG(TYPE('a))" |
"dist m x ≥ deltaG(TYPE('a)) ∧ dist m y ≥ deltaG(TYPE('a)) ∧ Gromov_product_at z x m ≤ Gromov_product_at z m y" |
"dist m x ≥ deltaG(TYPE('a)) ∧ dist m y ≥ deltaG(TYPE('a)) ∧ Gromov_product_at z m y ≤ Gromov_product_at z x m"
by linarith
then show ?thesis
proof (cases)
case 1
have "dist m z ≤ dist m x + dist x z"
by (intro mono_intros)
then show ?thesis using 1 by auto
next
case 2
have "dist m z ≤ dist m y + dist y z"
by (intro mono_intros)
then show ?thesis using 2 by auto
next
case 3
then have "Gromov_product_at z x m = min (Gromov_product_at z x m) (Gromov_product_at z m y)"
by auto
also have "... ≤ Gromov_product_at z x y + deltaG(TYPE('a))"
by (intro mono_intros)
finally have "dist z m ≤ dist z y + dist x m - dist x y + 2 * deltaG(TYPE('a))"
unfolding Gromov_product_at_def by (auto simp add: divide_simps algebra_simps)
also have "... = dist z y - dist m y + 2 * deltaG(TYPE('a))"
using geodesic_segment_dist[OF assms] by auto
also have "... ≤ dist z y + deltaG(TYPE('a))"
using 3 by auto
finally show ?thesis
by (simp add: metric_space_class.dist_commute)
next
case 4
then have "Gromov_product_at z m y = min (Gromov_product_at z x m) (Gromov_product_at z m y)"
by auto
also have "... ≤ Gromov_product_at z x y + deltaG(TYPE('a))"
by (intro mono_intros)
finally have "dist z m ≤ dist z x + dist m y - dist x y + 2 * deltaG(TYPE('a))"
unfolding Gromov_product_at_def by (auto simp add: divide_simps algebra_simps)
also have "... = dist z x - dist x m + 2 * deltaG(TYPE('a))"
using geodesic_segment_dist[OF assms] by auto
also have "... ≤ dist z x + deltaG(TYPE('a))"
using 4 by (simp add: metric_space_class.dist_commute)
finally show ?thesis
by (simp add: metric_space_class.dist_commute)
qed
qed
end
text ‹A useful variation around the previous properties is that quadrilaterals are thin, in the
following sense: if one has a union of three geodesics from $x$ to $t$, then a geodesic from $x$
to $t$ remains within distance $8\delta$ of the union of these 3 geodesics. We formulate the
statement in geodesic hyperbolic spaces as the proof requires the construction of an additional
geodesic, but in fact the statement is true without this assumption, thanks to the Bonk-Schramm
extension theorem.›
lemma (in Gromov_hyperbolic_space_geodesic) thin_quadrilaterals:
assumes "geodesic_segment_between Gxy x y"
"geodesic_segment_between Gyz y z"
"geodesic_segment_between Gzt z t"
"geodesic_segment_between Gxt x t"
"(w::'a) ∈ Gxt"
shows "infdist w (Gxy ∪ Gyz ∪ Gzt) ≤ 8 * deltaG(TYPE('a))"
proof -
have I: "infdist w ({x--z} ∪ Gzt) ≤ 4 * deltaG(TYPE('a))"
apply (rule thin_triangles[OF _ assms(3) assms(4) assms(5)])
by (simp add: geodesic_segment_commute)
have "∃u ∈ {x--z} ∪ Gzt. infdist w ({x--z} ∪ Gzt) = dist w u"
apply (rule infdist_proper_attained, auto intro!: proper_Un simp add: geodesic_segment_topology(7))
by (meson assms(3) geodesic_segmentI geodesic_segment_topology)
then obtain u where u: "u ∈ {x--z} ∪ Gzt" "infdist w ({x--z} ∪ Gzt) = dist w u"
by auto
have "infdist u (Gxy ∪ Gyz ∪ Gzt) ≤ 4 * deltaG(TYPE('a))"
proof (cases "u ∈ {x--z}")
case True
have "infdist u (Gxy ∪ Gyz ∪ Gzt) ≤ infdist u (Gxy ∪ Gyz)"
apply (intro mono_intros) using assms(1) by auto
also have "... ≤ 4 * deltaG(TYPE('a))"
using thin_triangles[OF geodesic_segment_commute[OF assms(1)] assms(2) _ True] by auto
finally show ?thesis
by auto
next
case False
then have *: "u ∈ Gzt" using u(1) by auto
have "infdist u (Gxy ∪ Gyz ∪ Gzt) ≤ infdist u Gzt"
apply (intro mono_intros) using assms(3) by auto
also have "... = 0" using * by auto
finally show ?thesis
using local.delta_nonneg by linarith
qed
moreover have "infdist w (Gxy ∪ Gyz ∪ Gzt) ≤ infdist u (Gxy ∪ Gyz ∪ Gzt) + dist w u"
by (intro mono_intros)
ultimately show ?thesis
using I u(2) by auto
qed
text ‹There are converses to the above statements: if triangles are thin, or slim, then the space
is Gromov-hyperbolic, for some $\delta$. We prove these criteria here, following the proofs in
Ghys (with a simplification in the case of slim triangles.›
text ‹The basic result we will use twice below is the following: if points on sides of triangles
at the same distance of the basepoint are close to each other up to the Gromov product, then the
space is hyperbolic. The proof goes as follows. One wants to show that $(x,z)_e \geq
\min((x,y)_e, (y,z)_e) - \delta = t-\delta$. On $[ex]$, $[ey]$ and $[ez]$, consider points
$wx$, $wy$ and $wz$ at distance $t$ of $e$. Then $wx$ and $wy$ are $\delta$-close by assumption,
and so are $wy$ and $wz$. Then $wx$ and $wz$ are $2\delta$-close. One can use these two points
to express $(x,z)_e$, and the result follows readily.›
lemma (in geodesic_space) controlled_thin_triangles_implies_hyperbolic:
assumes "⋀(x::'a) y z t Gxy Gxz. geodesic_segment_between Gxy x y ⟹ geodesic_segment_between Gxz x z ⟹ t ∈ {0..Gromov_product_at x y z}
⟹ dist (geodesic_segment_param Gxy x t) (geodesic_segment_param Gxz x t) ≤ delta"
shows "Gromov_hyperbolic_subset delta (UNIV::'a set)"
proof (rule Gromov_hyperbolic_subsetI2)
fix e x y z::'a
define t where "t = min (Gromov_product_at e x y) (Gromov_product_at e y z)"
define wx where "wx = geodesic_segment_param {e--x} e t"
define wy where "wy = geodesic_segment_param {e--y} e t"
define wz where "wz = geodesic_segment_param {e--z} e t"
have "dist wx wy ≤ delta"
unfolding wx_def wy_def t_def by (rule assms[of _ _ x _ y], auto)
have "dist wy wz ≤ delta"
unfolding wy_def wz_def t_def by (rule assms[of _ _ y _ z], auto)
have "t + dist wy x = dist e wx + dist wy x"
unfolding wx_def apply (auto intro!: geodesic_segment_param_in_geodesic_spaces(6)[symmetric])
unfolding t_def by (auto, meson Gromov_product_le_dist(1) min.absorb_iff2 min.left_idem order.trans)
also have "... ≤ dist e wx + (dist wy wx + dist wx x)"
by (intro mono_intros)
also have "... ≤ dist e wx + (delta + dist wx x)"
using ‹dist wx wy ≤ delta› by (auto simp add: metric_space_class.dist_commute)
also have "... = delta + dist e x"
apply auto apply (rule geodesic_segment_dist[of "{e--x}"])
unfolding wx_def t_def by (auto simp add: geodesic_segment_param_in_segment)
finally have *: "t + dist wy x - delta ≤ dist e x" by simp
have "t + dist wy z = dist e wz + dist wy z"
unfolding wz_def apply (auto intro!: geodesic_segment_param_in_geodesic_spaces(6)[symmetric])
unfolding t_def by (auto, meson Gromov_product_le_dist(2) min.absorb_iff1 min.right_idem order.trans)
also have "... ≤ dist e wz + (dist wy wz + dist wz z)"
by (intro mono_intros)
also have "... ≤ dist e wz + (delta + dist wz z)"
using ‹dist wy wz ≤ delta› by (auto simp add: metric_space_class.dist_commute)
also have "... = delta + dist e z"
apply auto apply (rule geodesic_segment_dist[of "{e--z}"])
unfolding wz_def t_def by (auto simp add: geodesic_segment_param_in_segment)
finally have "t + dist wy z - delta ≤ dist e z" by simp
then have "(t + dist wy x - delta) + (t + dist wy z - delta) ≤ dist e x + dist e z"
using * by simp
also have "... = dist x z + 2 * Gromov_product_at e x z"
unfolding Gromov_product_at_def by (auto simp add: algebra_simps divide_simps)
also have "... ≤ dist wy x + dist wy z + 2 * Gromov_product_at e x z"
using metric_space_class.dist_triangle[of x z wy] by (auto simp add: metric_space_class.dist_commute)
finally have "2 * t - 2 * delta ≤ 2 * Gromov_product_at e x z"
by auto
then show "min (Gromov_product_at e x y) (Gromov_product_at e y z) - delta ≤ Gromov_product_at e x z"
unfolding t_def by auto
qed
text ‹We prove that if triangles are thin, i.e., they satisfy the Rips condition, i.e., every side
of a triangle is included in the $\delta$-neighborhood of the union of the other triangles, then
the space is hyperbolic. If a point $w$ on $[xy]$ satisfies $d(x,w) < (y,z)_x - \delta$, then its
friend on $[xz] \cup [yz]$ has to be on $[xz]$, and roughly at the same distance of the origin.
Then it follows that the point on $[xz]$ with $d(x,w') = d(x,w)$ is close to $w$, as desired.
If $d(x,w) \in [(y,z)_x - \delta, (y,z)_x)$, we argue in the same way but for the point which
is closer to $x$ by an amount $\delta$. Finally, the last case $d(x,w) = (y,z)_x$ follows by
continuity.›
proposition (in geodesic_space) thin_triangles_implies_hyperbolic:
assumes "⋀(x::'a) y z w Gxy Gyz Gxz. geodesic_segment_between Gxy x y ⟹ geodesic_segment_between Gxz x z ⟹ geodesic_segment_between Gyz y z
⟹ w ∈ Gxy ⟹ infdist w (Gxz ∪ Gyz) ≤ delta"
shows "Gromov_hyperbolic_subset (4 * delta) (UNIV::'a set)"
proof -
obtain x0::'a where True by auto
have "infdist x0 ({x0} ∪ {x0}) ≤ delta"
by (rule assms[of "{x0}" x0 x0 "{x0}" x0 "{x0}" x0], auto)
then have [simp]: "delta ≥ 0"
using infdist_nonneg by auto
have "dist (geodesic_segment_param Gxy x t) (geodesic_segment_param Gxz x t) ≤ 4 * delta"
if H: "geodesic_segment_between Gxy x y" "geodesic_segment_between Gxz x z" "t ∈ {0..Gromov_product_at x y z}"
for x y z t Gxy Gxz
proof -
have Main: "dist (geodesic_segment_param Gxy x u) (geodesic_segment_param Gxz x u) ≤ 4 * delta"
if "u ∈ {delta..<Gromov_product_at x y z}" for u
proof -
define wy where "wy = geodesic_segment_param Gxy x (u-delta)"
have "dist wy (geodesic_segment_param Gxy x u) = abs((u-delta) - u)"
unfolding wy_def apply (rule geodesic_segment_param(7)[OF H(1)]) using that apply auto
using Gromov_product_le_dist(1)[of x y z] ‹delta ≥ 0› by linarith+
then have I1: "dist wy (geodesic_segment_param Gxy x u) = delta" by auto
have "infdist wy (Gxz ∪ {y--z}) ≤ delta"
unfolding wy_def apply (rule assms[of Gxy x y _ z]) using H by (auto simp add: geodesic_segment_param_in_segment)
moreover have "∃wz ∈ Gxz ∪ {y--z}. infdist wy (Gxz ∪ {y--z}) = dist wy wz"
apply (rule infdist_proper_attained, intro proper_Un)
using H(2) by (auto simp add: geodesic_segment_topology)
ultimately obtain wz where wz: "wz ∈ Gxz ∪ {y--z}" "dist wy wz ≤ delta"
by force
have "dist wz x ≤ dist wz wy + dist wy x"
by (rule metric_space_class.dist_triangle)
also have "... ≤ delta + (u-delta)"
apply (intro add_mono) using wz(2) unfolding wy_def apply (auto simp add: metric_space_class.dist_commute)
apply (intro eq_refl geodesic_segment_param(6)[OF H(1)])
using that apply auto
by (metis diff_0_right diff_mono dual_order.trans Gromov_product_le_dist(1) less_eq_real_def metric_space_class.dist_commute metric_space_class.zero_le_dist wy_def)
finally have "dist wz x ≤ u" by auto
also have "... < Gromov_product_at x y z"
using that by auto
also have "... ≤ infdist x {y--z}"
by (rule Gromov_product_le_infdist, auto)
finally have "dist x wz < infdist x {y--z}"
by (simp add: metric_space_class.dist_commute)
then have "wz ∉ {y--z}"
by (metis add.left_neutral infdist_triangle infdist_zero leD)
then have "wz ∈ Gxz"
using wz by auto
have "u - delta = dist x wy"
unfolding wy_def apply (rule geodesic_segment_param(6)[symmetric, OF H(1)])
using that apply auto
using Gromov_product_le_dist(1)[of x y z] ‹delta ≥ 0› by linarith
also have "... ≤ dist x wz + dist wz wy"
by (rule metric_space_class.dist_triangle)
also have "... ≤ dist x wz + delta"
using wz(2) by (simp add: metric_space_class.dist_commute)
finally have "dist x wz ≥ u - 2 * delta" by auto
define dz where "dz = dist x wz"
have *: "wz = geodesic_segment_param Gxz x dz"
unfolding dz_def using ‹wz ∈ Gxz› H(2) by auto
have "dist wz (geodesic_segment_param Gxz x u) = abs(dz - u)"
unfolding * apply (rule geodesic_segment_param(7)[OF H(2)])
unfolding dz_def using ‹dist wz x ≤ u› that apply (auto simp add: metric_space_class.dist_commute)
using Gromov_product_le_dist(2)[of x y z] ‹delta ≥ 0› by linarith+
also have "... ≤ 2 * delta"
unfolding dz_def using ‹dist wz x ≤ u› ‹dist x wz ≥ u - 2 * delta›
by (auto simp add: metric_space_class.dist_commute)
finally have I3: "dist wz (geodesic_segment_param Gxz x u) ≤ 2 * delta"
by simp
have "dist (geodesic_segment_param Gxy x u) (geodesic_segment_param Gxz x u)
≤ dist (geodesic_segment_param Gxy x u) wy + dist wy wz + dist wz (geodesic_segment_param Gxz x u)"
by (rule dist_triangle4)
also have "... ≤ delta + delta + (2 * delta)"
using I1 wz(2) I3 by (auto simp add: metric_space_class.dist_commute)
finally show ?thesis by simp
qed
have "t ∈ {0..dist x y}" "t ∈ {0..dist x z}" "t ≥ 0"
using ‹t ∈ {0..Gromov_product_at x y z}› apply auto
using Gromov_product_le_dist[of x y z] by linarith+
consider "t ≤ delta" | "t ∈ {delta..<Gromov_product_at x y z}" | "t = Gromov_product_at x y z ∧ t > delta"
using ‹t ∈ {0..Gromov_product_at x y z}› by (auto, linarith)
then show ?thesis
proof (cases)
case 1
have "dist (geodesic_segment_param Gxy x t) (geodesic_segment_param Gxz x t) ≤ dist x (geodesic_segment_param Gxy x t) + dist x (geodesic_segment_param Gxz x t)"
by (rule metric_space_class.dist_triangle3)
also have "... = t + t"
using geodesic_segment_param(6)[OF H(1) ‹t ∈ {0..dist x y}›] geodesic_segment_param(6)[OF H(2) ‹t ∈ {0..dist x z}›]
by auto
also have "... ≤ 4 * delta" using 1 ‹delta ≥ 0› by linarith
finally show ?thesis by simp
next
case 2
show ?thesis using Main[OF 2] by simp
next
case 3
text ‹In this case, we argue by approximating $t$ by a slightly smaller parameter, for which
the result has already been proved above. We need to argue that all functions are continuous
on the sets we are considering, which is straightforward but tedious.›
define u::"nat ⇒ real" where "u = (λn. t-1/n)"
have "u ⇢ t - 0"
unfolding u_def by (intro tendsto_intros)
then have "u ⇢ t" by simp
then have *: "eventually (λn. u n > delta) sequentially"
using 3 by (auto simp add: order_tendsto_iff)
have **: "eventually (λn. u n ≥ 0) sequentially"
apply (rule eventually_elim2[OF *, of "(λn. delta ≥ 0)"]) apply auto
using ‹delta ≥ 0› by linarith
have ***: "u n ≤ t" for n unfolding u_def by auto
have A: "eventually (λn. u n ∈ {delta..<Gromov_product_at x y z}) sequentially"
apply (auto intro!: eventually_conj)
apply (rule eventually_mono[OF *], simp)
unfolding u_def using 3 by auto
have B: "eventually (λn. dist (geodesic_segment_param Gxy x (u n)) (geodesic_segment_param Gxz x (u n)) ≤ 4 * delta) sequentially"
by (rule eventually_mono[OF A Main], simp)
have C: "(λn. dist (geodesic_segment_param Gxy x (u n)) (geodesic_segment_param Gxz x (u n)))
⇢ dist (geodesic_segment_param Gxy x t) (geodesic_segment_param Gxz x t)"
apply (intro tendsto_intros)
apply (rule continuous_on_tendsto_compose[OF _ ‹u ⇢ t› ‹t ∈ {0..dist x y}›])
apply (simp add: isometry_on_continuous H(1))
using ** *** ‹t ∈ {0..dist x y}› apply (simp, intro eventually_conj, simp, meson dual_order.trans eventually_mono)
apply (rule continuous_on_tendsto_compose[OF _ ‹u ⇢ t› ‹t ∈ {0..dist x z}›])
apply (simp add: isometry_on_continuous H(2))
using ** *** ‹t ∈ {0..dist x z}› apply (simp, intro eventually_conj, simp, meson dual_order.trans eventually_mono)
done
show ?thesis
using B unfolding eventually_sequentially using LIMSEQ_le_const2[OF C] by simp
qed
qed
with controlled_thin_triangles_implies_hyperbolic[OF this]
show ?thesis by auto
qed
text ‹Then, we prove that if triangles are slim (i.e., there is a point that is $\delta$-close to
all sides), then the space is hyperbolic. Using the previous statement, we should show that points
on $[xy]$ and $[xz]$ at the same distance $t$ of the origin are close, if $t \leq (y,z)_x$.
There are two steps:
- for $t = (y,z)_x$, then the two points are in fact close to the middle of the triangle
(as this point satisfies $d(x,y) = d(x,w) + d(w,y) + O(\delta)$, and similarly for the other sides,
one gets readily $d(x,w) = (y,z)_w + O(\delta)$ by expanding the formula for the Gromov product).
Hence, they are close together.
- For $t < (y,z)_x$, we argue that there are points $y' \in [xy]$ and $z' \in [xz]$ for which
$t = (y',z')_x$, by a continuity argument and the intermediate value theorem.
Then the result follows from the first step in the triangle $xy'z'$.
The proof we give is simpler than the one in~\cite{ghys_hyperbolique}, and gives better constants.›
proposition (in geodesic_space) slim_triangles_implies_hyperbolic:
assumes "⋀(x::'a) y z Gxy Gyz Gxz. geodesic_segment_between Gxy x y ⟹ geodesic_segment_between Gxz x z ⟹ geodesic_segment_between Gyz y z
⟹ ∃w. infdist w Gxy ≤ delta ∧ infdist w Gxz ≤ delta ∧ infdist w Gyz ≤ delta"
shows "Gromov_hyperbolic_subset (6 * delta) (UNIV::'a set)"
proof -
text ‹First step: the result is true for $t = (y,z)_x$.›
have Main: "dist (geodesic_segment_param Gxy x (Gromov_product_at x y z)) (geodesic_segment_param Gxz x (Gromov_product_at x y z)) ≤ 6 * delta"
if H: "geodesic_segment_between Gxy x y" "geodesic_segment_between Gxz x z"
for x y z Gxy Gxz
proof -
obtain w where w: "infdist w Gxy ≤ delta" "infdist w Gxz ≤ delta" "infdist w {y--z} ≤ delta"
using assms[OF H, of "{y--z}"] by auto
have "∃wxy ∈ Gxy. infdist w Gxy = dist w wxy"
apply (rule infdist_proper_attained) using H(1) by (auto simp add: geodesic_segment_topology)
then obtain wxy where wxy: "wxy ∈ Gxy" "dist w wxy ≤ delta"
using w by auto
have "∃wxz ∈ Gxz. infdist w Gxz = dist w wxz"
apply (rule infdist_proper_attained) using H(2) by (auto simp add: geodesic_segment_topology)
then obtain wxz where wxz: "wxz ∈ Gxz" "dist w wxz ≤ delta"
using w by auto
have "∃wyz ∈ {y--z}. infdist w {y--z} = dist w wyz"
apply (rule infdist_proper_attained) by (auto simp add: geodesic_segment_topology)
then obtain wyz where wyz: "wyz ∈ {y--z}" "dist w wyz ≤ delta"
using w by auto
have I: "dist wxy wxz ≤ 2 * delta" "dist wxy wyz ≤ 2 * delta" "dist wxz wyz ≤ 2 * delta"
using metric_space_class.dist_triangle[of wxy wxz w] metric_space_class.dist_triangle[of wxy wyz w] metric_space_class.dist_triangle[of wxz wyz w]
wxy(2) wyz(2) wxz(2) by (auto simp add: metric_space_class.dist_commute)
text ‹We show that $d(x, wxy)$ is close to the Gromov product of $y$ and $z$ seen from $x$.
This follows from the fact that $w$ is essentially on all geodesics, so that everything simplifies
when one writes down the Gromov products, leaving only $d(x, w)$ up to $O(\delta)$.
To get the right $O(\delta)$, one has to be a little bit careful, using the triangular inequality
when possible. This means that the computations for the upper and lower bounds are different,
making them a little bit tedious, although straightforward.›
have "dist y wxy -4 * delta + dist wxy z ≤ dist y wxy - dist wxy wyz + dist wxy z - dist wxy wyz"
using I by simp
also have "... ≤ dist wyz y + dist wyz z"
using metric_space_class.dist_triangle[of y wxy wyz] metric_space_class.dist_triangle[of wxy z wyz]
by (auto simp add: metric_space_class.dist_commute)
also have "... = dist y z"
using wyz(1) by (metis geodesic_segment_dist local.some_geodesic_is_geodesic_segment(1) metric_space_class.dist_commute)
finally have *: "dist y wxy + dist wxy z - 4 * delta ≤ dist y z" by simp
have "2 * Gromov_product_at x y z = dist x y + dist x z - dist y z"
unfolding Gromov_product_at_def by simp
also have "... ≤ dist x wxy + dist wxy y + dist x wxy + dist wxy z - (dist y wxy + dist wxy z - 4 * delta)"
using metric_space_class.dist_triangle[of x y wxy] metric_space_class.dist_triangle[of x z wxy] *
by (auto simp add: metric_space_class.dist_commute)
also have "... = 2 * dist x wxy + 4 * delta"
by (auto simp add: metric_space_class.dist_commute)
finally have A: "Gromov_product_at x y z ≤ dist x wxy + 2 * delta" by simp
have "dist x wxy -4 * delta + dist wxy z ≤ dist x wxy - dist wxy wxz + dist wxy z - dist wxy wxz"
using I by simp
also have "... ≤ dist wxz x + dist wxz z"
using metric_space_class.dist_triangle[of x wxy wxz] metric_space_class.dist_triangle[of wxy z wxz]
by (auto simp add: metric_space_class.dist_commute)
also have "... = dist x z"
using wxz(1) H(2) by (metis geodesic_segment_dist metric_space_class.dist_commute)
finally have *: "dist x wxy + dist wxy z - 4 * delta ≤ dist x z" by simp
have "2 * dist x wxy - 4 * delta = (dist x wxy + dist wxy y) + (dist x wxy + dist wxy z - 4 * delta) - (dist y wxy + dist wxy z)"
by (auto simp add: metric_space_class.dist_commute)
also have "... ≤ dist x y + dist x z - dist y z"
using * metric_space_class.dist_triangle[of y z wxy] geodesic_segment_dist[OF H(1) wxy(1)] by auto
also have "... = 2 * Gromov_product_at x y z"
unfolding Gromov_product_at_def by simp
finally have B: "Gromov_product_at x y z ≥ dist x wxy - 2 * delta" by simp
define dy where "dy = dist x wxy"
have *: "wxy = geodesic_segment_param Gxy x dy"
unfolding dy_def using ‹wxy ∈ Gxy› H(1) by auto
have "dist wxy (geodesic_segment_param Gxy x (Gromov_product_at x y z)) = abs(dy - Gromov_product_at x y z)"
unfolding * apply (rule geodesic_segment_param(7)[OF H(1)])
unfolding dy_def using that geodesic_segment_dist_le[OF H(1) wxy(1), of x] by (auto simp add: metric_space_class.dist_commute)
also have "... ≤ 2 * delta"
using A B unfolding dy_def by auto
finally have Iy: "dist wxy (geodesic_segment_param Gxy x (Gromov_product_at x y z)) ≤ 2 * delta"
by simp
text ‹We need the same estimate for $wxz$. The proof is exactly the same, copied and pasted.
It would be better to have a separate statement, but since its assumptions would be rather
cumbersome I decided to keep the two proofs.›
have "dist z wxz -4 * delta + dist wxz y ≤ dist z wxz - dist wxz wyz + dist wxz y - dist wxz wyz"
using I by simp
also have "... ≤ dist wyz z + dist wyz y"
using metric_space_class.dist_triangle[of z wxz wyz] metric_space_class.dist_triangle[of wxz y wyz]
by (auto simp add: metric_space_class.dist_commute)
also have "... = dist z y"
using ‹dist wyz y + dist wyz z = dist y z› by (auto simp add: metric_space_class.dist_commute)
finally have *: "dist z wxz + dist wxz y - 4 * delta ≤ dist z y" by simp
have "2 * Gromov_product_at x y z = dist x z + dist x y - dist z y"
unfolding Gromov_product_at_def by (simp add: metric_space_class.dist_commute)
also have "... ≤ dist x wxz + dist wxz z + dist x wxz + dist wxz y - (dist z wxz + dist wxz y - 4 * delta)"
using metric_space_class.dist_triangle[of x z wxz] metric_space_class.dist_triangle[of x y wxz] *
by (auto simp add: metric_space_class.dist_commute)
also have "... = 2 * dist x wxz + 4 * delta"
by (auto simp add: metric_space_class.dist_commute)
finally have A: "Gromov_product_at x y z ≤ dist x wxz + 2 * delta" by simp
have "dist x wxz -4 * delta + dist wxz y ≤ dist x wxz - dist wxz wxy + dist wxz y - dist wxz wxy"
using I by (simp add: metric_space_class.dist_commute)
also have "... ≤ dist wxy x + dist wxy y"
using metric_space_class.dist_triangle[of x wxz wxy] metric_space_class.dist_triangle[of wxz y wxy]
by (auto simp add: metric_space_class.dist_commute)
also have "... = dist x y"
using wxy(1) H(1) by (metis geodesic_segment_dist metric_space_class.dist_commute)
finally have *: "dist x wxz + dist wxz y - 4 * delta ≤ dist x y" by simp
have "2 * dist x wxz - 4 * delta = (dist x wxz + dist wxz z) + (dist x wxz + dist wxz y - 4 * delta) - (dist z wxz + dist wxz y)"
by (auto simp add: metric_space_class.dist_commute)
also have "... ≤ dist x z + dist x y - dist z y"
using * metric_space_class.dist_triangle[of z y wxz] geodesic_segment_dist[OF H(2) wxz(1)] by auto
also have "... = 2 * Gromov_product_at x y z"
unfolding Gromov_product_at_def by (simp add: metric_space_class.dist_commute)
finally have B: "Gromov_product_at x y z ≥ dist x wxz - 2 * delta" by simp
define dz where "dz = dist x wxz"
have *: "wxz = geodesic_segment_param Gxz x dz"
unfolding dz_def using ‹wxz ∈ Gxz› H(2) by auto
have "dist wxz (geodesic_segment_param Gxz x (Gromov_product_at x y z)) = abs(dz - Gromov_product_at x y z)"
unfolding * apply (rule geodesic_segment_param(7)[OF H(2)])
unfolding dz_def using that geodesic_segment_dist_le[OF H(2) wxz(1), of x] by (auto simp add: metric_space_class.dist_commute)
also have "... ≤ 2 * delta"
using A B unfolding dz_def by auto
finally have Iz: "dist wxz (geodesic_segment_param Gxz x (Gromov_product_at x y z)) ≤ 2 * delta"
by simp
have "dist (geodesic_segment_param Gxy x (Gromov_product_at x y z)) (geodesic_segment_param Gxz x (Gromov_product_at x y z))
≤ dist (geodesic_segment_param Gxy x (Gromov_product_at x y z)) wxy + dist wxy wxz + dist wxz (geodesic_segment_param Gxz x (Gromov_product_at x y z))"
by (rule dist_triangle4)
also have "... ≤ 2 * delta + 2 * delta + 2 * delta"
using Iy Iz I by (auto simp add: metric_space_class.dist_commute)
finally show ?thesis by simp
qed
text ‹Second step: the result is true for $t \leq (y,z)_x$, by a continuity argument and a
reduction to the first step.›
have "dist (geodesic_segment_param Gxy x t) (geodesic_segment_param Gxz x t) ≤ 6 * delta"
if H: "geodesic_segment_between Gxy x y" "geodesic_segment_between Gxz x z" "t ∈ {0..Gromov_product_at x y z}"
for x y z t Gxy Gxz
proof -
define ys where "ys = (λs. geodesic_segment_param Gxy x (s * dist x y))"
define zs where "zs = (λs. geodesic_segment_param Gxz x (s * dist x z))"
define F where "F = (λs. Gromov_product_at x (ys s) (zs s))"
have "∃s. 0 ≤ s ∧ s ≤ 1 ∧ F s = t"
proof (rule IVT')
show "F 0 ≤ t" "t ≤ F 1"
unfolding F_def using that unfolding ys_def zs_def by (auto simp add: Gromov_product_e_x_x)
show "continuous_on {0..1} F"
unfolding F_def Gromov_product_at_def ys_def zs_def
apply (intro continuous_intros continuous_on_compose2[of "{0..dist x y}" _ _ "λt. t * dist x y"] continuous_on_compose2[of "{0..dist x z}" _ _ "λt. t * dist x z"])
apply (auto intro!: isometry_on_continuous geodesic_segment_param(4) that)
using metric_space_class.zero_le_dist mult_left_le_one_le by blast+
qed (simp)
then obtain s where s: "s ∈ {0..1}" "t = Gromov_product_at x (ys s) (zs s)"
unfolding F_def by auto
have a: "x = geodesic_segment_param Gxy x 0" using H(1) by auto
have b: "x = geodesic_segment_param Gxz x 0" using H(2) by auto
have dy: "dist x (ys s) = s * dist x y"
unfolding ys_def apply (rule geodesic_segment_param[OF H(1)]) using s(1) by (auto simp add: mult_left_le_one_le)
have dz: "dist x (zs s) = s * dist x z"
unfolding zs_def apply (rule geodesic_segment_param[OF H(2)]) using s(1) by (auto simp add: mult_left_le_one_le)
define Gxy2 where "Gxy2 = geodesic_subsegment Gxy x 0 (s * dist x y)"
define Gxz2 where "Gxz2 = geodesic_subsegment Gxz x 0 (s * dist x z)"
have "dist (geodesic_segment_param Gxy2 x t) (geodesic_segment_param Gxz2 x t) ≤ 6 * delta"
unfolding s(2) proof (rule Main)
show "geodesic_segment_between Gxy2 x (ys s)"
apply (subst a) unfolding Gxy2_def ys_def apply (rule geodesic_subsegment[OF H(1)])
using s(1) by (auto simp add: mult_left_le_one_le)
show "geodesic_segment_between Gxz2 x (zs s)"
apply (subst b) unfolding Gxz2_def zs_def apply (rule geodesic_subsegment[OF H(2)])
using s(1) by (auto simp add: mult_left_le_one_le)
qed
moreover have "geodesic_segment_param Gxy2 x (t-0) = geodesic_segment_param Gxy x t"
apply (subst a) unfolding Gxy2_def apply (rule geodesic_subsegment(3)[OF H(1)])
using s(1) H(3) unfolding s(2) apply (auto simp add: mult_left_le_one_le)
unfolding dy[symmetric] by (rule Gromov_product_le_dist)
moreover have "geodesic_segment_param Gxz2 x (t-0) = geodesic_segment_param Gxz x t"
apply (subst b) unfolding Gxz2_def apply (rule geodesic_subsegment(3)[OF H(2)])
using s(1) H(3) unfolding s(2) apply (auto simp add: mult_left_le_one_le)
unfolding dz[symmetric] by (rule Gromov_product_le_dist)
ultimately show ?thesis by simp
qed
with controlled_thin_triangles_implies_hyperbolic[OF this]
show ?thesis by auto
qed
section ‹Metric trees›
text ‹Metric trees have several equivalent definitions. The simplest one is probably that it
is a geodesic space in which the union of two geodesic segments intersecting only at one endpoint is
still a geodesic segment.
Metric trees are Gromov hyperbolic, with $\delta = 0$.›
class metric_tree = geodesic_space +
assumes geod_union: "geodesic_segment_between G x y ⟹ geodesic_segment_between H y z ⟹ G ∩ H = {y} ⟹ geodesic_segment_between (G ∪ H) x z"
text ‹We will now show that the real line is a metric tree, by identifying its geodesic
segments, i.e., the compact intervals.›
lemma geodesic_segment_between_real:
assumes "x ≤ (y::real)"
shows "geodesic_segment_between (G::real set) x y = (G = {x..y})"
proof
assume H: "geodesic_segment_between G x y"
then have "connected G" "x ∈ G" "y ∈ G"
using geodesic_segment_topology(2) geodesic_segmentI geodesic_segment_endpoints by auto
then have *: "{x..y} ⊆ G"
by (simp add: connected_contains_Icc)
moreover have "G ⊆ {x..y}"
proof
fix s assume "s ∈ G"
have "abs(s-x) + abs(s-y) = abs(x-y)"
using geodesic_segment_dist[OF H ‹s ∈ G›] unfolding dist_real_def by auto
then show "s ∈ {x..y}" using ‹x ≤ y› by auto
qed
ultimately show "G = {x..y}" by auto
next
assume H: "G = {x..y}"
define g where "g = (λt. t + x)"
have "g 0 = x ∧ g (dist x y) = y ∧ isometry_on {0..dist x y} g ∧ G = g ` {0..dist x y}"
unfolding g_def isometry_on_def H using ‹x ≤ y› by (auto simp add: dist_real_def)
then have "∃g. g 0 = x ∧ g (dist x y) = y ∧ isometry_on {0..dist x y} g ∧ G = g ` {0..dist x y}"
by auto
then show "geodesic_segment_between G x y" unfolding geodesic_segment_between_def by auto
qed
lemma geodesic_segment_between_real':
"{x--y} = {min x y..max x (y::real)}"
by (metis geodesic_segment_between_real geodesic_segment_commute some_geodesic_is_geodesic_segment(1) max_def min.cobounded1 min_def)
lemma geodesic_segment_real:
"geodesic_segment (G::real set) = (∃x y. x ≤ y ∧ G = {x..y})"
proof
assume "geodesic_segment G"
then obtain x y where *: "geodesic_segment_between G x y" unfolding geodesic_segment_def by auto
have "(x ≤ y ∧ G = {x..y}) ∨ (y ≤ x ∧ G = {y..x})"
apply (rule le_cases[of x y])
using geodesic_segment_between_real * geodesic_segment_commute apply simp
using geodesic_segment_between_real * geodesic_segment_commute by metis
then show "∃x y. x ≤ y ∧ G = {x..y}" by auto
next
assume "∃x y. x ≤ y ∧ G = {x..y}"
then show "geodesic_segment G"
unfolding geodesic_segment_def using geodesic_segment_between_real by metis
qed
instance real::metric_tree
proof
fix G H::"real set" and x y z::real assume GH: "geodesic_segment_between G x y" "geodesic_segment_between H y z" "G ∩ H = {y}"
have G: "G = {min x y..max x y}" using GH
by (metis geodesic_segment_between_real geodesic_segment_commute inf_real_def inf_sup_ord(2) max.coboundedI2 max_def min_def)
have H: "H = {min y z..max y z}" using GH
by (metis geodesic_segment_between_real geodesic_segment_commute inf_real_def inf_sup_ord(2) max.coboundedI2 max_def min_def)
have *: "(x ≤ y ∧ y ≤ z) ∨ (z ≤ y ∧ y ≤ x)"
using G H ‹G ∩ H = {y}› unfolding min_def max_def
apply auto
apply (metis (mono_tags, hide_lams) min_le_iff_disj order_refl)
by (metis (full_types) less_eq_real_def max_def)
show "geodesic_segment_between (G ∪ H) x z"
using * apply rule
using ‹G ∩ H = {y}› unfolding G H apply (metis G GH(1) GH(2) H geodesic_segment_between_real ivl_disj_un_two_touch(4) order_trans)
using ‹G ∩ H = {y}› unfolding G H
by (metis (full_types) Un_commute geodesic_segment_between_real geodesic_segment_commute ivl_disj_un_two_touch(4) le_max_iff_disj max.absorb_iff2 max.commute min_absorb2)
qed
context metric_tree begin
text ‹We show that a metric tree is uniquely geodesic.›
subclass uniquely_geodesic_space
proof
fix x y G H assume H: "geodesic_segment_between G x y" "geodesic_segment_between H x (y::'a)"
show "G = H"
proof (rule uniquely_geodesic_spaceI[OF _ H])
fix G H x y assume "geodesic_segment_between G x y" "geodesic_segment_between H x y" "G ∩ H = {x, (y::'a)}"
show "x = y"
proof (rule ccontr)
assume "x ≠ y"
then have "dist x y > 0" by auto
obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
by (meson ‹geodesic_segment_between G x y› geodesic_segment_between_def)
define G2 where "G2 = g`{0..dist x y/2}"
have "G2 ⊆ G" unfolding G2_def g(4) by auto
define z where "z = g(dist x y/2)"
have "dist x z = dist x y/2"
using isometry_onD[OF g(3), of 0 "dist x y/2"] g(1) z_def unfolding dist_real_def by auto
have "dist y z = dist x y/2"
using isometry_onD[OF g(3), of "dist x y" "dist x y/2"] g(2) z_def unfolding dist_real_def by auto
have G2: "geodesic_segment_between G2 x z" unfolding ‹g 0 = x›[symmetric] z_def G2_def
apply (rule geodesic_segmentI2) by (rule isometry_on_subset[OF g(3)], auto simp add: ‹g 0 = x›)
have [simp]: "x ∈ G2" "z ∈ G2" using geodesic_segment_endpoints G2 by auto
have "dist x a ≤ dist x z" if "a ∈ G2" for a
apply (rule geodesic_segment_dist_le) using G2 that by auto
also have "... < dist x y" unfolding ‹dist x z = dist x y/2› using ‹dist x y > 0› by auto
finally have "y ∉ G2" by auto
then have "G2 ∩ H = {x}"
using ‹G2 ⊆ G› ‹x ∈ G2› ‹G ∩ H = {x, y}› by auto
have *: "geodesic_segment_between (G2 ∪ H) z y"
apply (rule geod_union[of _ _ x])
using ‹G2 ∩ H = {x}› ‹geodesic_segment_between H x y› G2 by (auto simp add: geodesic_segment_commute)
have "dist x y ≤ dist z x + dist x y" by auto
also have "... = dist z y"
apply (rule geodesic_segment_dist[OF *]) using ‹G ∩ H = {x, y}› by auto
also have "... = dist x y / 2"
by (simp add: ‹dist y z = dist x y / 2› metric_space_class.dist_commute)
finally show False using ‹dist x y > 0› by auto
qed
qed
qed
text ‹An important property of metric trees is that any geodesic triangle is degenerate, i.e., the
three sides intersect at a unique point, the center of the triangle, that we introduce now.›
definition center::"'a ⇒ 'a ⇒ 'a ⇒ 'a"
where "center x y z = (SOME t. t ∈ {x--y} ∩ {x--z} ∩ {y--z})"
lemma center_as_intersection:
"{x--y} ∩ {x--z} ∩ {y--z} = {center x y z}"
proof -
obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "{x--y} = g`{0..dist x y}"
by (meson geodesic_segment_between_def some_geodesic_is_geodesic_segment(1))
obtain h where h: "h 0 = x" "h (dist x z) = z" "isometry_on {0..dist x z} h" "{x--z} = h`{0..dist x z}"
by (meson geodesic_segment_between_def some_geodesic_is_geodesic_segment(1))
define Z where "Z = {t ∈ {0..min (dist x y) (dist x z)}. g t = h t}"
have "0 ∈ Z" unfolding Z_def using g(1) h(1) by auto
have [simp]: "closed Z"
proof -
have *: "Z = (λs. dist (g s) (h s))-`{0} ∩ {0..min (dist x y) (dist x z)}"
unfolding Z_def by auto
show ?thesis
unfolding * apply (rule closed_vimage_Int)
using continuous_on_subset[OF isometry_on_continuous[OF g(3)], of "{0..min (dist x y) (dist x z)}"]
continuous_on_subset[OF isometry_on_continuous[OF h(3)], of "{0..min (dist x y) (dist x z)}"]
continuous_on_dist by auto
qed
define a where "a = Sup Z"
have "a ∈ Z"
unfolding a_def apply (rule closed_contains_Sup, auto) using ‹0 ∈ Z› Z_def by auto
define c where "c = h a"
then have a: "g a = c" "h a = c" "a ≥ 0" "a ≤ dist x y" "a ≤ dist x z"
using ‹a ∈ Z› unfolding Z_def c_def by auto
define G2 where "G2 = g`{a..dist x y}"
have G2: "geodesic_segment_between G2 (g a) (g (dist x y))"
unfolding G2_def apply (rule geodesic_segmentI2)
using isometry_on_subset[OF g(3)] ‹a ∈ Z› unfolding Z_def by auto
define H2 where "H2 = h`{a..dist x z}"
have H2: "geodesic_segment_between H2 (h a) (h (dist x z))"
unfolding H2_def apply (rule geodesic_segmentI2)
using isometry_on_subset[OF h(3)] ‹a ∈ Z› unfolding Z_def by auto
have "G2 ∩ H2 ⊆ {c}"
proof
fix w assume w: "w ∈ G2 ∩ H2"
obtain sg where sg: "w = g sg" "sg ∈ {a..dist x y}" using w unfolding G2_def by auto
obtain sh where sh: "w = h sh" "sh ∈ {a..dist x z}" using w unfolding H2_def by auto
have "dist w x = sg"
unfolding g(1)[symmetric] sg(1) using isometry_onD[OF g(3), of 0 sg] sg(2)
unfolding dist_real_def using a by (auto simp add: metric_space_class.dist_commute)
moreover have "dist w x = sh"
unfolding h(1)[symmetric] sh(1) using isometry_onD[OF h(3), of 0 sh] sh(2)
unfolding dist_real_def using a by (auto simp add: metric_space_class.dist_commute)
ultimately have "sg = sh" by simp
have "sh ∈ Z" unfolding Z_def using sg sh ‹a ≥ 0› unfolding ‹sg = sh› by auto
then have "sh ≤ a"
unfolding a_def apply (rule cSup_upper) unfolding Z_def by auto
then have "sh = a" using sh(2) by auto
then show "w ∈ {c}" unfolding sh(1) using a(2) by auto
qed
then have *: "G2 ∩ H2 = {c}"
unfolding G2_def H2_def using a by (auto simp add: image_iff, force)
have "geodesic_segment_between (G2 ∪ H2) y z"
apply (subst g(2)[symmetric], subst h(2)[symmetric]) apply(rule geod_union[of _ _ "h a"])
using geodesic_segment_commute G2 H2 a * by force+
then have "G2 ∪ H2 = {y--z}"
using geodesic_segment_unique by auto
then have "c ∈ {y--z}" using * by auto
then have *: "c ∈ {x--y} ∩ {x--z} ∩ {y--z}"
using g(4) h(4) c_def a by force
have center: "center x y z ∈ {x--y} ∩ {x--z} ∩ {y--z}"
unfolding center_def using someI[of "λp. p ∈ {x--y} ∩ {x--z} ∩ {y--z}", OF *] by blast
have *: "dist x d = Gromov_product_at x y z" if "d ∈ {x--y} ∩ {x--z} ∩ {y--z}" for d
proof -
have "dist x y = dist x d + dist d y"
"dist x z = dist x d + dist d z"
"dist y z = dist y d + dist d z"
using that by (auto simp add: geodesic_segment_dist geodesic_segment_unique)
then show ?thesis unfolding Gromov_product_at_def by (auto simp add: metric_space_class.dist_commute)
qed
have "d = center x y z" if "d ∈ {x--y} ∩ {x--z} ∩ {y--z}" for d
apply (rule geodesic_segment_dist_unique[of "{x--y}" x y])
using *[OF that] *[OF center] that center by auto
then show "{x--y} ∩ {x--z} ∩ {y--z} = {center x y z}" using center by blast
qed
lemma center_on_geodesic [simp]:
"center x y z ∈ {x--y}"
"center x y z ∈ {x--z}"
"center x y z ∈ {y--z}"
"center x y z ∈ {y--x}"
"center x y z ∈ {z--x}"
"center x y z ∈ {z--y}"
using center_as_intersection by (auto simp add: some_geodesic_commute)
lemma center_commute:
"center x y z = center x z y"
"center x y z = center y x z"
"center x y z = center y z x"
"center x y z = center z x y"
"center x y z = center z y x"
using center_as_intersection some_geodesic_commute by blast+
lemma center_dist:
"dist x (center x y z) = Gromov_product_at x y z"
proof -
have "dist x y = dist x (center x y z) + dist (center x y z) y"
"dist x z = dist x (center x y z) + dist (center x y z) z"
"dist y z = dist y (center x y z) + dist (center x y z) z"
by (auto simp add: geodesic_segment_dist geodesic_segment_unique)
then show ?thesis unfolding Gromov_product_at_def by (auto simp add: metric_space_class.dist_commute)
qed
lemma geodesic_intersection:
"{x--y} ∩ {x--z} = {x--center x y z}"
proof -
have "{x--y} = {x--center x y z} ∪ {center x y z--y}"
using center_as_intersection geodesic_segment_split by blast
moreover have "{x--z} = {x--center x y z} ∪ {center x y z--z}"
using center_as_intersection geodesic_segment_split by blast
ultimately have "{x--y} ∩ {x--z} = {x--center x y z} ∪ ({center x y z--y} ∩ {x--center x y z}) ∪ ({center x y z--y} ∩ {x--center x y z}) ∪ ({center x y z--y} ∩ {center x y z--z})"
by auto
moreover have "{center x y z--y} ∩ {x--center x y z} = {center x y z}"
using geodesic_segment_split(2) center_as_intersection[of x y z] by auto
moreover have "{center x y z--y} ∩ {x--center x y z} = {center x y z}"
using geodesic_segment_split(2) center_as_intersection[of x y z] by auto
moreover have "{center x y z--y} ∩ {center x y z--z} = {center x y z}"
using geodesic_segment_split(2)[of "center x y z" y z] center_as_intersection[of x y z] by (auto simp add: some_geodesic_commute)
ultimately show "{x--y} ∩ {x--z} = {x--center x y z}" by auto
qed
end
text ‹We can now prove that a metric tree is Gromov hyperbolic, for $\delta = 0$. The simplest
proof goes through the slim triangles property: it suffices to show that, given a geodesic triangle,
there is a point at distance at most $0$ of each of its sides. This is the center we have
constructed above.›
class metric_tree_with_delta = metric_tree + metric_space_with_deltaG +
assumes delta0: "deltaG(TYPE('a::metric_space)) = 0"
class Gromov_hyperbolic_space_0 = Gromov_hyperbolic_space +
assumes delta0 [simp]: "deltaG(TYPE('a::metric_space)) = 0"
class Gromov_hyperbolic_space_0_geodesic = Gromov_hyperbolic_space_0 + geodesic_space
text ‹Isabelle does not accept cycles in the class graph. So, we will show that
\verb+metric_tree_with_delta+ is a subclass of \verb+Gromov_hyperbolic_space_0_geodesic+, and
conversely that \verb+Gromov_hyperbolic_space_0_geodesic+ is a subclass of \verb+metric_tree+.
In a tree, we have already proved that triangles are $0$-slim (the center is common to all sides
of the triangle). The $0$-hyperbolicity follows from one of the equivalent characterizations
of hyperbolicity (the other characterizations could be used as well, but the proofs would be
less immediate.)›
subclass (in metric_tree_with_delta) Gromov_hyperbolic_space_0
proof (standard)
show "deltaG TYPE('a) = 0" unfolding delta0 by auto
have "Gromov_hyperbolic_subset (6 * 0) (UNIV::'a set)"
proof (rule slim_triangles_implies_hyperbolic)
fix x::'a and y z Gxy Gyz Gxz
define w where "w = center x y z"
assume "geodesic_segment_between Gxy x y"
"geodesic_segment_between Gxz x z" "geodesic_segment_between Gyz y z"
then have "Gxy = {x--y}" "Gyz = {y--z}" "Gxz = {x--z}"
by (auto simp add: local.geodesic_segment_unique)
then have "w ∈ Gxy" "w ∈ Gyz" "w ∈ Gxz"
unfolding w_def by auto
then have "infdist w Gxy ≤ 0 ∧ infdist w Gxz ≤ 0 ∧ infdist w Gyz ≤ 0"
by auto
then show "∃w. infdist w Gxy ≤ 0 ∧ infdist w Gxz ≤ 0 ∧ infdist w Gyz ≤ 0"
by blast
qed
then show "Gromov_hyperbolic_subset (deltaG TYPE('a)) (UNIV::'a set)" unfolding delta0 by auto
qed
text ‹To use the fact that reals are Gromov hyperbolic, given that they are a metric tree,
we need to instantiate them as \verb+metric_tree_with_delta+.›
instantiation real::metric_tree_with_delta
begin
definition deltaG_real::"real itself ⇒ real"
where "deltaG_real _ = 0"
instance apply standard unfolding deltaG_real_def by auto
end
text ‹Let us now prove the converse: a geodesic space which is $\delta$-hyperbolic for $\delta = 0$
is a metric tree. For the proof, we consider two geodesic segments $G = [x,y]$ and $H = [y,z]$ with a common
endpoint, and we have to show that their union is still a geodesic segment from $x$ to $z$. For
this, introduce a geodesic segment $L = [x,z]$. By the property of thin triangles, $G$ is included
in $H \cup L$. In particular, a point $Y$ close to $y$ but different from $y$ on $G$ is on $L$,
and therefore realizes the equality $d(x,z) = d(x, Y) + d(Y, z)$. Passing to the limit, $y$
also satisfies this equality. The conclusion readily follows thanks to Lemma
\verb+geodesic_segment_union+.
›
subclass (in Gromov_hyperbolic_space_0_geodesic) metric_tree
proof
fix G H x y z assume A: "geodesic_segment_between G x y" "geodesic_segment_between H y z" "G ∩ H = {y::'a}"
show "geodesic_segment_between (G ∪ H) x z"
proof (cases "x = y")
case True
then show ?thesis
by (metis A Un_commute geodesic_segment_between_x_x(3) inf.commute sup_inf_absorb)
next
case False
define D::"nat ⇒ real" where "D = (λn. dist x y - (dist x y) * (1/(real(n+1))))"
have D: "D n ∈ {0..< dist x y}" "D n ∈ {0..dist x y}" for n
unfolding D_def by (auto simp add: False divide_simps algebra_simps)
have Dlim: "D ⇢ dist x y - dist x y * 0"
unfolding D_def by (intro tendsto_intros LIMSEQ_ignore_initial_segment[OF lim_1_over_n, of 1])
define Y::"nat ⇒ 'a" where "Y = (λn. geodesic_segment_param G x (D n))"
have *: "Y ⇢ y"
unfolding Y_def apply (subst geodesic_segment_param(2)[OF A(1), symmetric])
using isometry_on_continuous[OF geodesic_segment_param(4)[OF A(1)]]
unfolding continuous_on_sequentially comp_def using D(2) Dlim by auto
have "dist x z = dist x (Y n) + dist (Y n) z" for n
proof -
obtain L where L: "geodesic_segment_between L x z" using geodesic_subsetD[OF geodesic] by blast
have "Y n ∈ G" unfolding Y_def
apply (rule geodesic_segment_param(3)[OF A(1)]) using D[of n] by auto
have "dist x (Y n) = D n"
unfolding Y_def apply (rule geodesic_segment_param[OF A(1)]) using D[of n] by auto
then have "Y n ≠ y"
using D[of n] by auto
then have "Y n ∉ H" using A(3) ‹Y n ∈ G› by auto
have "infdist (Y n) (H ∪ L) ≤ 4 * deltaG(TYPE('a))"
apply (rule thin_triangles[OF geodesic_segment_commute[OF A(2)] geodesic_segment_commute[OF L] geodesic_segment_commute[OF A(1)]])
using ‹Y n ∈ G› by simp
then have "infdist (Y n) (H ∪ L) = 0"
using infdist_nonneg[of "Y n" "H ∪ L"] unfolding delta0 by auto
have "Y n ∈ H ∪ L"
proof (subst in_closed_iff_infdist_zero)
have "closed H"
using A(2) geodesic_segment_topology geodesic_segment_def by fastforce
moreover have "closed L"
using L geodesic_segment_topology geodesic_segment_def by fastforce
ultimately show "closed (H ∪ L)" by auto
show "H ∪ L ≠ {}" using A(2) geodesic_segment_endpoints(1) by auto
qed (fact)
then have "Y n ∈ L" using ‹Y n ∉ H› by simp
show ?thesis using geodesic_segment_dist[OF L ‹Y n ∈ L›] by simp
qed
moreover have "(λn. dist x (Y n) + dist (Y n) z) ⇢ dist x y + dist y z"
by (intro tendsto_intros *)
ultimately have "(λn. dist x z) ⇢ dist x y + dist y z"
using filterlim_cong eventually_sequentially by auto
then have *: "dist x z = dist x y + dist y z"
using LIMSEQ_unique by auto
show "geodesic_segment_between (G ∪ H) x z"
by (rule geodesic_segment_union[OF * A(1) A(2)])
qed
qed
end
Theory Morse_Gromov_Theorem
theory Morse_Gromov_Theorem
imports "HOL-Decision_Procs.Approximation" Gromov_Hyperbolicity Hausdorff_Distance
begin
hide_const (open) Approximation.Min
hide_const (open) Approximation.Max
section ‹Quasiconvexity›
text ‹In a Gromov-hyperbolic setting, convexity is not a well-defined notion as everything should
be coarse. The good replacement is quasi-convexity: A set $X$ is $C$-quasi-convex if any pair of
points in $X$ can be joined by a geodesic that remains within distance $C$ of $X$. One could also
require this for all geodesics, up to changing $C$, as two geodesics between the same endpoints
remain within uniformly bounded distance. We use the first definition to ensure that a geodesic is
$0$-quasi-convex.›
definition quasiconvex::"real ⇒ ('a::metric_space) set ⇒ bool"
where "quasiconvex C X = (C ≥ 0 ∧ (∀x∈X. ∀y∈X. ∃G. geodesic_segment_between G x y ∧ (∀z∈G. infdist z X ≤ C)))"
lemma quasiconvexD:
assumes "quasiconvex C X" "x ∈ X" "y ∈ X"
shows "∃G. geodesic_segment_between G x y ∧ (∀z∈G. infdist z X ≤ C)"
using assms unfolding quasiconvex_def by auto
lemma quasiconvexC:
assumes "quasiconvex C X"
shows "C ≥ 0"
using assms unfolding quasiconvex_def by auto
lemma quasiconvexI:
assumes "C ≥ 0"
"⋀x y. x ∈ X ⟹ y ∈ X ⟹ (∃G. geodesic_segment_between G x y ∧ (∀z∈G. infdist z X ≤ C))"
shows "quasiconvex C X"
using assms unfolding quasiconvex_def by auto
lemma quasiconvex_of_geodesic:
assumes "geodesic_segment G"
shows "quasiconvex 0 G"
proof (rule quasiconvexI, simp)
fix x y assume *: "x ∈ G" "y ∈ G"
obtain H where H: "H ⊆ G" "geodesic_segment_between H x y"
using geodesic_subsegment_exists[OF assms(1) *] by auto
have "infdist z G ≤ 0" if "z ∈ H" for z
using H(1) that by auto
then show "∃H. geodesic_segment_between H x y ∧ (∀z∈H. infdist z G ≤ 0)"
using H(2) by auto
qed
lemma quasiconvex_empty:
assumes "C ≥ 0"
shows "quasiconvex C {}"
unfolding quasiconvex_def using assms by auto
lemma quasiconvex_mono:
assumes "C ≤ D"
"quasiconvex C G"
shows "quasiconvex D G"
using assms unfolding quasiconvex_def by (auto, fastforce)
text ‹The $r$-neighborhood of a quasi-convex set is still quasi-convex in a hyperbolic space,
for a constant that does not depend on $r$.›
lemma (in Gromov_hyperbolic_space_geodesic) quasiconvex_thickening:
assumes "quasiconvex C (X::'a set)" "r ≥ 0"
shows "quasiconvex (C + 8 *deltaG(TYPE('a))) (⋃x∈X. cball x r)"
proof (rule quasiconvexI)
show "C + 8 *deltaG(TYPE('a)) ≥ 0" using quasiconvexC[OF assms(1)] by simp
next
fix y z assume *: "y ∈ (⋃x∈X. cball x r)" "z ∈ (⋃x∈X. cball x r)"
have A: "infdist w (⋃x∈X. cball x r) ≤ C + 8 * deltaG TYPE('a)" if "w ∈ {y--z}" for w
proof -
obtain py where py: "py ∈ X" "y ∈ cball py r"
using * by auto
obtain pz where pz: "pz ∈ X" "z ∈ cball pz r"
using * by auto
obtain G where G: "geodesic_segment_between G py pz" "(∀p∈G. infdist p X ≤ C)"
using quasiconvexD[OF assms(1) ‹py ∈ X› ‹pz ∈ X›] by auto
have A: "infdist w ({y--py} ∪ G ∪ {pz--z}) ≤ 8 * deltaG(TYPE('a))"
by (rule thin_quadrilaterals[OF _ G(1) _ _ ‹w ∈ {y--z}›, where ?x = y and ?t = z], auto)
have "∃u ∈ {y--py} ∪ G ∪ {pz--z}. infdist w ({y--py} ∪ G ∪ {pz--z}) = dist w u"
apply (rule infdist_proper_attained, auto intro!: proper_Un simp add: geodesic_segment_topology(7))
by (meson G(1) geodesic_segmentI geodesic_segment_topology(7))
then obtain u where u: "u ∈ {y--py} ∪ G ∪ {pz--z}" "infdist w ({y--py} ∪ G ∪ {pz--z}) = dist w u"
by auto
then consider "u ∈ {y--py}" | "u ∈ G" | "u ∈ {pz--z}" by auto
then have "infdist u (⋃x∈X. cball x r) ≤ C"
proof (cases)
case 1
then have "dist py u ≤ dist py y"
using geodesic_segment_dist_le local.some_geodesic_is_geodesic_segment(1) some_geodesic_commute some_geodesic_endpoints(1) by blast
also have "... ≤ r"
using py(2) by auto
finally have "u ∈ cball py r"
by auto
then have "u ∈ (⋃x∈X. cball x r)"
using py(1) by auto
then have "infdist u (⋃x∈X. cball x r) = 0"
by auto
then show ?thesis
using quasiconvexC[OF assms(1)] by auto
next
case 3
then have "dist pz u ≤ dist pz z"
using geodesic_segment_dist_le local.some_geodesic_is_geodesic_segment(1) some_geodesic_commute some_geodesic_endpoints(1) by blast
also have "... ≤ r"
using pz(2) by auto
finally have "u ∈ cball pz r"
by auto
then have "u ∈ (⋃x∈X. cball x r)"
using pz(1) by auto
then have "infdist u (⋃x∈X. cball x r) = 0"
by auto
then show ?thesis
using quasiconvexC[OF assms(1)] by auto
next
case 2
have "infdist u (⋃x∈X. cball x r) ≤ infdist u X"
apply (rule infdist_mono) using assms(2) py(1) by auto
then show ?thesis using 2 G(2) by auto
qed
moreover have "infdist w (⋃x∈X. cball x r) ≤ infdist u (⋃x∈X. cball x r) + dist w u"
by (intro mono_intros)
ultimately show ?thesis
using A u(2) by auto
qed
show "∃G. geodesic_segment_between G y z ∧ (∀w∈G. infdist w (⋃x∈X. cball x r) ≤ C + 8 * deltaG TYPE('a))"
apply (rule exI[of _ "{y--z}"]) using A by auto
qed
text ‹If $x$ has a projection $p$ on a quasi-convex set $G$, then all segments from a point in $G$
to $x$ go close to $p$, i.e., the triangular inequality $d(x,y) \leq d(x,p) + d(p,y)$ is essentially
an equality, up to an additive constant.›
lemma (in Gromov_hyperbolic_space_geodesic) dist_along_quasiconvex:
assumes "quasiconvex C G" "p ∈ proj_set x G" "y ∈ G"
shows "dist x p + dist p y ≤ dist x y + 4 * deltaG(TYPE('a)) + 2 * C"
proof -
have *: "p ∈ G"
using assms proj_setD by auto
obtain H where H: "geodesic_segment_between H p y" "⋀q. q ∈ H ⟹ infdist q G ≤ C"
using quasiconvexD[OF assms(1) * assms(3)] by auto
have "∃m∈H. infdist x H = dist x m"
apply (rule infdist_proper_attained[of H x]) using geodesic_segment_topology[OF geodesic_segmentI[OF H(1)]] by auto
then obtain m where m: "m ∈ H" "infdist x H = dist x m" by auto
then have I: "dist x m ≤ Gromov_product_at x p y + 2 * deltaG(TYPE('a))"
using infdist_triangle_side[OF H(1), of x] by auto
have "dist x p - dist x m - C ≤ e" if "e > 0" for e
proof -
have "∃r∈G. dist m r < infdist m G + e"
apply (rule infdist_almost_attained) using ‹e > 0› assms(3) by auto
then obtain r where r: "r ∈ G" "dist m r < infdist m G + e"
by auto
then have *: "dist m r ≤ C + e" using H(2)[OF ‹m ∈ H›] by auto
have "dist x p ≤ dist x r"
using ‹r ∈ G› assms(2) proj_set_dist_le by blast
also have "... ≤ dist x m + dist m r"
by (intro mono_intros)
finally show ?thesis using * by (auto simp add: metric_space_class.dist_commute)
qed
then have "dist x p - dist x m - C ≤ 0"
using dense_ge by blast
then show ?thesis
using I unfolding Gromov_product_at_def by (auto simp add: algebra_simps divide_simps)
qed
text ‹The next lemma is~\cite[Proposition 10.2.1]{coornaert_delzant_papadopoulos} with better
constants. It states that the distance between the projections
on a quasi-convex set is controlled by the distance of the original points, with a gain given by the
distances of the points to the set.›
lemma (in Gromov_hyperbolic_space_geodesic) proj_along_quasiconvex_contraction:
assumes "quasiconvex C G" "px ∈ proj_set x G" "py ∈ proj_set y G"
shows "dist px py ≤ max (5 * deltaG(TYPE('a)) + 2 * C) (dist x y - dist px x - dist py y + 10 * deltaG(TYPE('a)) + 4 * C)"
proof -
have "px ∈ G" "py ∈ G"
using assms proj_setD by auto
have "(dist x px + dist px py - 4 * deltaG(TYPE('a)) - 2 * C) + (dist y py + dist py px - 4 *deltaG(TYPE('a)) - 2 * C)
≤ dist x py + dist y px"
apply (intro mono_intros)
using dist_along_quasiconvex[OF assms(1) assms(2) ‹py ∈ G›] dist_along_quasiconvex[OF assms(1) assms(3) ‹px ∈ G›] by auto
also have "... ≤ max (dist x y + dist py px) (dist x px + dist py y) + 2 * deltaG(TYPE('a))"
by (rule hyperb_quad_ineq)
finally have *: "dist x px + dist y py + 2 * dist px py
≤ max (dist x y + dist py px) (dist x px + dist py y) + 10 * deltaG(TYPE('a)) + 4 * C"
by (auto simp add: metric_space_class.dist_commute)
show ?thesis
proof (cases "dist x y + dist py px ≥ dist x px + dist py y")
case True
then have "dist x px + dist y py + 2 * dist px py ≤ dist x y + dist py px + 10 * deltaG(TYPE('a)) + 4 * C"
using * by auto
then show ?thesis by (auto simp add: metric_space_class.dist_commute)
next
case False
then have "dist x px + dist y py + 2 * dist px py ≤ dist x px + dist py y + 10 * deltaG(TYPE('a)) + 4 * C"
using * by auto
then show ?thesis by (simp add: metric_space_class.dist_commute)
qed
qed
text ‹The projection on a quasi-convex set is $1$-Lipschitz up to an additive error.›
lemma (in Gromov_hyperbolic_space_geodesic) proj_along_quasiconvex_contraction':
assumes "quasiconvex C G" "px ∈ proj_set x G" "py ∈ proj_set y G"
shows "dist px py ≤ dist x y + 4 * deltaG(TYPE('a)) + 2 * C"
proof (cases "dist y py ≤ dist x px")
case True
have "dist x px + dist px py ≤ dist x py + 4 * deltaG(TYPE('a)) + 2 * C"
by (rule dist_along_quasiconvex[OF assms(1) assms(2) proj_setD(1)[OF assms(3)]])
also have "... ≤ (dist x y + dist y py) + 4 * deltaG(TYPE('a)) + 2 * C"
by (intro mono_intros)
finally show ?thesis using True by auto
next
case False
have "dist y py + dist py px ≤ dist y px + 4 * deltaG(TYPE('a)) + 2 * C"
by (rule dist_along_quasiconvex[OF assms(1) assms(3) proj_setD(1)[OF assms(2)]])
also have "... ≤ (dist y x + dist x px) + 4 * deltaG(TYPE('a)) + 2 * C"
by (intro mono_intros)
finally show ?thesis using False by (auto simp add: metric_space_class.dist_commute)
qed
text ‹We can in particular specialize the previous statements to geodesics, which are
$0$-quasi-convex.›
lemma (in Gromov_hyperbolic_space_geodesic) dist_along_geodesic:
assumes "geodesic_segment G" "p ∈ proj_set x G" "y ∈ G"
shows "dist x p + dist p y ≤ dist x y + 4 * deltaG(TYPE('a))"
using dist_along_quasiconvex[OF quasiconvex_of_geodesic[OF assms(1)] assms(2) assms(3)] by auto
lemma (in Gromov_hyperbolic_space_geodesic) proj_along_geodesic_contraction:
assumes "geodesic_segment G" "px ∈ proj_set x G" "py ∈ proj_set y G"
shows "dist px py ≤ max (5 * deltaG(TYPE('a))) (dist x y - dist px x - dist py y + 10 * deltaG(TYPE('a)))"
using proj_along_quasiconvex_contraction[OF quasiconvex_of_geodesic[OF assms(1)] assms(2) assms(3)] by auto
lemma (in Gromov_hyperbolic_space_geodesic) proj_along_geodesic_contraction':
assumes "geodesic_segment G" "px ∈ proj_set x G" "py ∈ proj_set y G"
shows "dist px py ≤ dist x y + 4 * deltaG(TYPE('a))"
using proj_along_quasiconvex_contraction'[OF quasiconvex_of_geodesic[OF assms(1)] assms(2) assms(3)] by auto
text ‹If one projects a continuous curve on a quasi-convex set, the image does not have to be
connected (the projection is discontinuous), but since the projections of nearby points are within
uniformly bounded distance one can find in the projection a point with almost prescribed distance
to the starting point, say. For further applications, we also pick the first such point, i.e.,
all the previous points are also close to the starting point.›
lemma (in Gromov_hyperbolic_space_geodesic) quasi_convex_projection_small_gaps:
assumes "continuous_on {a..(b::real)} f"
"a ≤ b"
"quasiconvex C G"
"⋀t. t ∈ {a..b} ⟹ p t ∈ proj_set (f t) G"
"delta > deltaG(TYPE('a))"
"d ∈ {4 * delta + 2 * C..dist (p a) (p b)}"
shows "∃t ∈ {a..b}. (dist (p a) (p t) ∈ {d - 4 * delta - 2 * C .. d})
∧ (∀s ∈ {a..t}. dist (p a) (p s) ≤ d)"
proof -
have "delta > 0"
using assms(5) local.delta_nonneg by linarith
moreover have "C ≥ 0"
using quasiconvexC[OF assms(3)] by simp
ultimately have "d ≥ 0" using assms by auto
text ‹The idea is to define the desired point as the last point $u$ for which there is a projection
at distance at most $d$ of the starting point. Then the projection can not be much closer to
the starting point, or one could point another such point further away by almost continuity, giving
a contradiction. The technical implementation requires some care, as the "last point" may not
satisfy the property, for lack of continuity. If it does, then fine. Otherwise, one should go just
a little bit to its left to find the desired point.›
define I where "I = {t ∈ {a..b}. ∀s ∈ {a..t}. dist (p a) (p s) ≤ d}"
have "a ∈ I"
using ‹a ≤ b› ‹d ≥ 0› unfolding I_def by auto
have "bdd_above I"
unfolding I_def by auto
define u where "u = Sup I"
have "a ≤ u"
unfolding u_def apply (rule cSup_upper) using ‹a ∈ I› ‹bdd_above I› by auto
have "u ≤ b"
unfolding u_def apply (rule cSup_least) using ‹a ∈ I› apply auto unfolding I_def by auto
have A: "dist (p a) (p s) ≤ d" if "s < u" "a ≤ s" for s
proof -
have "∃t∈I. s < t"
unfolding u_def apply (subst less_cSup_iff[symmetric])
using ‹a ∈ I› ‹bdd_above I› using ‹s < u› unfolding u_def by auto
then obtain t where t: "t ∈ I" "s < t" by auto
then have "s ∈ {a..t}" using ‹a ≤ s› by auto
then show ?thesis
using t(1) unfolding I_def by auto
qed
have "continuous (at u within {a..b}) f"
using assms(1) by (simp add: ‹a ≤ u› ‹u ≤ b› continuous_on_eq_continuous_within)
then have "∃i > 0. ∀s∈{a..b}. dist u s < i ⟶ dist (f u) (f s) < (delta - deltaG(TYPE('a)))"
unfolding continuous_within_eps_delta using ‹deltaG(TYPE('a)) < delta› by (auto simp add: metric_space_class.dist_commute)
then obtain e0 where e0: "e0 > 0" "⋀s. s ∈ {a..b} ⟹ dist u s < e0 ⟹ dist (f u) (f s) < (delta - deltaG(TYPE('a)))"
by auto
show ?thesis
proof (cases "dist (p a) (p u) > d")
text ‹First, consider the case where $u$ does not satisfy the defining property. Then the
desired point $t$ is taken slightly to its left.›
case True
then have "u ≠ a"
using ‹d ≥ 0› by auto
then have "a < u" using ‹a ≤ u› by auto
define e::real where "e = min (e0/2) ((u-a)/2)"
then have "e > 0" using ‹a < u› ‹e0 > 0› by auto
define t where "t = u - e"
then have "t < u" using ‹e > 0› by auto
have "u - b ≤ e" "e ≤ u - a"
using ‹e > 0› ‹u ≤ b› unfolding e_def by (auto simp add: min_def)
then have "t ∈ {a..b}" "t ∈ {a..t}"
unfolding t_def by auto
have "dist u t < e0"
unfolding t_def e_def dist_real_def using ‹e0 > 0› ‹a ≤ u› by auto
have *: "∀s ∈ {a..t}. dist (p a) (p s) ≤ d"
using A ‹t < u› by auto
have "dist (p t) (p u) ≤ dist (f t) (f u) + 4 * deltaG(TYPE('a)) + 2 * C"
apply (rule proj_along_quasiconvex_contraction'[OF ‹quasiconvex C G›])
using assms (4) ‹t ∈ {a..b}› ‹a ≤ u› ‹u ≤ b› by auto
also have "... ≤ (delta - deltaG(TYPE('a))) + 4 * deltaG(TYPE('a)) + 2 * C"
apply (intro mono_intros)
using e0(2)[OF ‹t ∈ {a..b}› ‹dist u t < e0›] by (auto simp add: metric_space_class.dist_commute)
finally have I: "dist (p t) (p u) ≤ 4 * delta + 2 * C"
using ‹delta > deltaG(TYPE('a))› by simp
have "d ≤ dist (p a) (p u)"
using True by auto
also have "... ≤ dist (p a) (p t) + dist (p t) (p u)"
by (intro mono_intros)
also have "... ≤ dist (p a) (p t) + 4 * delta + 2 * C"
using I by simp
finally have **: "d - 4 * delta - 2 * C ≤ dist (p a) (p t)"
by simp
show ?thesis
apply (rule bexI[OF _ ‹t ∈ {a..b}›]) using * ** ‹t ∈ {a..b}› by auto
next
text ‹Next, consider the case where $u$ satisfies the defining property. Then we will take $t = u$.
The only nontrivial point to check is that the distance of $f(u)$ to the starting point is not
too small. For this, we need to separate the case where $u = b$ (in which case one argues directly)
and the case where $u < b$, where one can use a point slightly to the right of $u$ which has a
projection at distance $ > d$ of the starting point, and use almost continuity.›
case False
have B: "dist (p a) (p s) ≤ d" if "s ∈ {a..u}" for s
proof (cases "s = u")
case True
show ?thesis
unfolding True using False by auto
next
case False
then show ?thesis
using that A by auto
qed
have C: "dist (p a) (p u) ≥ d - 4 *delta - 2 * C"
proof (cases "u = b")
case True
have "d ≤ dist (p a) (p b)"
using assms by auto
also have "... ≤ dist (p a) (p u) + dist (p u) (p b)"
by (intro mono_intros)
also have "... ≤ dist (p a) (p u) + (dist (f u) (f b) + 4 * deltaG TYPE('a) + 2 * C)"
apply (intro mono_intros proj_along_quasiconvex_contraction'[OF ‹quasiconvex C G›])
using assms ‹a ≤ u› ‹u ≤ b› by auto
finally show ?thesis
unfolding True using ‹deltaG(TYPE('a)) < delta› by auto
next
case False
then have "u < b"
using ‹u ≤ b› by auto
define e::real where "e = min (e0/2) ((b-u)/2)"
then have "e > 0" using ‹u < b› ‹e0 > 0› by auto
define v where "v = u + e"
then have "u < v"
using ‹e > 0› by auto
have "e ≤ b - u" "a - u ≤ e"
using ‹e > 0› ‹a ≤ u› unfolding e_def by (auto simp add: min_def)
then have "v ∈ {a..b}"
unfolding v_def by auto
moreover have "v ∉ I"
using ‹u < v› ‹bdd_above I› cSup_upper not_le unfolding u_def by auto
ultimately have "∃w ∈ {a..v}. dist (p a) (p w) > d"
unfolding I_def by force
then obtain w where w: "w ∈ {a..v}" "dist (p a) (p w) > d"
by auto
then have "w ∉ {a..u}"
using B by force
then have "u < w"
using w(1) by auto
have "w ∈ {a..b}"
using w(1) ‹v ∈ {a..b}› by auto
have "dist u w = w - u"
unfolding dist_real_def using ‹u < w› by auto
also have "... ≤ v - u"
using w(1) by auto
also have "... < e0"
unfolding v_def e_def min_def using ‹e0 > 0› by auto
finally have "dist u w < e0" by simp
have "dist (p u) (p w) ≤ dist (f u) (f w) + 4 * deltaG(TYPE('a)) + 2 * C"
apply (rule proj_along_quasiconvex_contraction'[OF ‹quasiconvex C G›])
using assms ‹a ≤ u› ‹u ≤ b› ‹w ∈ {a..b}› by auto
also have "... ≤ (delta - deltaG(TYPE('a))) + 4 * deltaG(TYPE('a)) + 2 * C"
apply (intro mono_intros)
using e0(2)[OF ‹w ∈ {a..b}› ‹dist u w < e0›] by (auto simp add: metric_space_class.dist_commute)
finally have I: "dist (p u) (p w) ≤ 4 * delta + 2 * C"
using ‹delta > deltaG(TYPE('a))› by simp
have "d ≤ dist (p a) (p u) + dist (p u) (p w)"
using w(2) metric_space_class.dist_triangle[of "p a" "p w" "p u"] by auto
also have "... ≤ dist (p a) (p u) + 4 * delta + 2 * C"
using I by auto
finally show ?thesis by simp
qed
show ?thesis
apply (rule bexI[of _ u])
using B ‹a ≤ u› ‹u ≤ b› C by auto
qed
qed
text ‹Same lemma, except that one exchanges the roles of the beginning and the end point.›
lemma (in Gromov_hyperbolic_space_geodesic) quasi_convex_projection_small_gaps':
assumes "continuous_on {a..(b::real)} f"
"a ≤ b"
"quasiconvex C G"
"⋀x. x ∈ {a..b} ⟹ p x ∈ proj_set (f x) G"
"delta > deltaG(TYPE('a))"
"d ∈ {4 * delta + 2 * C..dist (p a) (p b)}"
shows "∃t ∈ {a..b}. dist (p b) (p t) ∈ {d - 4 * delta - 2 * C .. d}
∧ (∀s ∈ {t..b}. dist (p b) (p s) ≤ d)"
proof -
have *: "continuous_on {-b..-a} (λt. f(-t))"
using continuous_on_compose[of "{-b..-a}" "λt. -t" f] using assms(1) continuous_on_minus[OF continuous_on_id] by auto
define q where "q = (λt. p(-t))"
have "∃t ∈ {-b..-a}. (dist (q (-b)) (q t) ∈ {d - 4 * delta - 2 * C .. d})
∧ (∀s ∈ {-b..t}. dist (q (-b)) (q s) ≤ d)"
apply (rule quasi_convex_projection_small_gaps[where ?f = "λt. f(-t)" and ?G = G])
unfolding q_def using assms * by (auto simp add: metric_space_class.dist_commute)
then obtain t where t: "t ∈ {-b..-a}" "dist (q (-b)) (q t) ∈ {d - 4 * delta - 2 * C .. d}"
"⋀s. s ∈ {-b..t} ⟹ dist (q (-b)) (q s) ≤ d"
by blast
have *: "dist (p b) (p s) ≤ d" if "s ∈ {-t..b}" for s
using t(3)[of "-s"] that q_def by auto
show ?thesis
apply (rule bexI[of _ "-t"]) using t * q_def by auto
qed
section ‹The Morse-Gromov Theorem›
text ‹The goal of this section is to prove a central basic result in the theory of hyperbolic spaces,
usually called the Morse Lemma. It is really
a theorem, and we add the name Gromov the avoid the confusion with the other Morse lemma
on the existence of good coordinates for $C^2$ functions with non-vanishing hessian.
It states that a quasi-geodesic remains within bounded distance of a geodesic with the same
endpoints, the error depending only on $\delta$ and on the parameters $(\lambda, C)$ of the
quasi-geodesic, but not on its length.
There are several proofs of this result. We will follow the one of Shchur~\cite{shchur}, which
gets an optimal dependency in terms of the parameters of the quasi-isometry, contrary to all
previous proofs. The price to pay is that the proof is more involved (relying in particular on
the fact that the closest point projection on quasi-convex sets is exponentially contracting).
We will also give afterwards for completeness the proof in~\cite{bridson_haefliger}, as it brings
up interesting tools, although the dependency it gives is worse.›
text ‹The next lemma (for $C = 0$, Lemma 2 in~\cite{shchur}) asserts that, if two points are not too far apart (at distance at most
$10 \delta$), and far enough from a given geodesic segment, then when one moves towards this
geodesic segment by a fixed amount (here $5 \delta$), then the two points become closer (the new
distance is at most $5 \delta$, gaining a factor of $2$). Later, we will iterate this lemma to
show that the projection on a geodesic segment is exponentially contracting. For the application,
we give a more general version involving an additional constant $C$.
This lemma holds for $\delta$ the hyperbolicity constant. We will want to apply it with $\delta > 0$,
so to avoid problems in the case $\delta = 0$ we formulate it not using the hyperbolicity constant of
the given type, but any constant which is at least the hyperbolicity constant (this is to work
around the fact that one can not say or use easily in Isabelle that a type with hyperbolicity
$\delta$ is also hyperbolic for any larger constant $\delta'$.›
lemma (in Gromov_hyperbolic_space_geodesic) geodesic_projection_exp_contracting_aux:
assumes "geodesic_segment G"
"px ∈ proj_set x G"
"py ∈ proj_set y G"
"delta ≥ deltaG(TYPE('a))"
"dist x y ≤ 10 * delta + C"
"M ≥ 15/2 * delta"
"dist px x ≥ M + 5 * delta + C/2"
"dist py y ≥ M + 5 * delta + C/2"
"C ≥ 0"
shows "dist (geodesic_segment_param {px--x} px M)
(geodesic_segment_param {py--y} py M) ≤ 5 * delta"
proof -
have "dist px x ≤ dist py x"
using proj_setD(2)[OF assms(2)] infdist_le[OF proj_setD(1)[OF assms(3)], of x] by (simp add: metric_space_class.dist_commute)
have "dist py y ≤ dist px y"
using proj_setD(2)[OF assms(3)] infdist_le[OF proj_setD(1)[OF assms(2)], of y] by (simp add: metric_space_class.dist_commute)
have "delta ≥ 0"
using assms local.delta_nonneg by linarith
then have M: "M ≥ 0" "M ≤ dist px x" "M ≤ dist px y" "M ≤ dist py x" "M ≤ dist py y"
using assms ‹dist px x ≤ dist py x› ‹dist py y ≤ dist px y ›by auto
have "px ∈ G" "py ∈ G"
using assms proj_setD by auto
define x' where "x' = geodesic_segment_param {px--x} px M"
define y' where "y' = geodesic_segment_param {py--y} py M"
text ‹First step: the distance between $px$ and $py$ is at most $5\delta$.›
have "dist px py ≤ max (5 * deltaG(TYPE('a))) (dist x y - dist px x - dist py y + 10 * deltaG(TYPE('a)))"
by (rule proj_along_geodesic_contraction[OF assms(1) assms(2) assms(3)])
also have "... ≤ max (5 * deltaG(TYPE('a))) (5 * deltaG(TYPE('a)))"
apply (intro mono_intros) using assms ‹delta ≥ 0› by auto
finally have "dist px py ≤ 5 * delta"
using ‹delta ≥ deltaG(TYPE('a))› by auto
text ‹Second step: show that all the interesting Gromov products at bounded below by $M$.›
have *: "x' ∈ {px--x}" unfolding x'_def
by (simp add: geodesic_segment_param_in_segment)
have "px ∈ proj_set x' G"
by (rule proj_set_geodesic_same_basepoint[OF ‹px ∈ proj_set x G› _ *], auto)
have "dist px x' = M"
unfolding x'_def using M by auto
have "dist px x' ≤ dist py x'"
using proj_setD(2)[OF ‹px ∈ proj_set x' G›] infdist_le[OF proj_setD(1)[OF assms(3)], of x'] by (simp add: metric_space_class.dist_commute)
have **: "dist px x = dist px x' + dist x' x"
using geodesic_segment_dist[OF _ *, of px x] by auto
have Ixx: "Gromov_product_at px x' x = M"
unfolding Gromov_product_at_def ** x'_def using M by auto
have "2 * M = dist px x' + dist px x - dist x' x"
unfolding ** x'_def using M by auto
also have "... ≤ dist py x' + dist py x - dist x' x"
apply (intro mono_intros, auto) by fact+
also have "... = 2 * Gromov_product_at py x x'"
unfolding Gromov_product_at_def by (auto simp add: metric_space_class.dist_commute)
finally have Iyx: "Gromov_product_at py x x' ≥ M" by auto
have *: "y' ∈ {py--y}" unfolding y'_def
by (simp add: geodesic_segment_param_in_segment)
have "py ∈ proj_set y' G"
by (rule proj_set_geodesic_same_basepoint[OF ‹py ∈ proj_set y G› _ *], auto)
have "dist py y' = M"
unfolding y'_def using M by auto
have "dist py y' ≤ dist px y'"
using proj_setD(2)[OF ‹py ∈ proj_set y' G›] infdist_le[OF proj_setD(1)[OF assms(2)], of y'] by (simp add: metric_space_class.dist_commute)
have **: "dist py y = dist py y' + dist y' y"
using geodesic_segment_dist[OF _ *, of py y] by auto
have Iyy: "Gromov_product_at py y' y = M"
unfolding Gromov_product_at_def ** y'_def using M by auto
have "2 * M = dist py y' + dist py y - dist y' y"
unfolding ** y'_def using M by auto
also have "... ≤ dist px y' + dist px y - dist y' y"
apply (intro mono_intros, auto) by fact+
also have "... = 2 * Gromov_product_at px y y'"
unfolding Gromov_product_at_def by (auto simp add: metric_space_class.dist_commute)
finally have Ixy: "Gromov_product_at px y y' ≥ M" by auto
have "2 * M ≤ dist px x + dist py y - dist x y"
using assms by auto
also have "... ≤ dist px x + dist px y - dist x y"
by (intro mono_intros, fact)
also have "... = 2 * Gromov_product_at px x y"
unfolding Gromov_product_at_def by auto
finally have Ix: "Gromov_product_at px x y ≥ M"
by auto
have "2 * M ≤ dist px x + dist py y - dist x y"
using assms by auto
also have "... ≤ dist py x + dist py y - dist x y"
by (intro mono_intros, fact)
also have "... = 2 * Gromov_product_at py x y"
unfolding Gromov_product_at_def by auto
finally have Iy: "Gromov_product_at py x y ≥ M"
by auto
text ‹Third step: prove the estimate›
have "M - 2 * delta ≤ Min {Gromov_product_at px x' x, Gromov_product_at px x y, Gromov_product_at px y y'} - 2 * deltaG(TYPE('a))"
using Ixx Ixy Ix ‹delta ≥ deltaG(TYPE('a))› by auto
also have "... ≤ Gromov_product_at px x' y'"
by (intro mono_intros)
finally have A: "M - 4 * delta + dist x' y' ≤ dist px y'"
unfolding Gromov_product_at_def ‹dist px x' = M› by auto
have "M - 2 * delta ≤ Min {Gromov_product_at py x' x, Gromov_product_at py x y, Gromov_product_at py y y'} - 2 * deltaG(TYPE('a))"
using Iyx Iyy Iy ‹delta ≥ deltaG(TYPE('a))› by (auto simp add: Gromov_product_commute)
also have "... ≤ Gromov_product_at py x' y'"
by (intro mono_intros)
finally have B: "M - 4 * delta + dist x' y' ≤ dist py x'"
unfolding Gromov_product_at_def ‹dist py y' = M› by auto
have "dist px py ≤ 2 * M - 10 * delta"
using assms ‹dist px py ≤ 5 * delta› by auto
have "2 * M - 8 * delta + 2 * dist x' y' ≤ dist px y' + dist py x'"
using A B by auto
also have "... ≤ max (dist px py + dist y' x') (dist px x' + dist y' py) + 2 * deltaG TYPE('a)"
by (rule hyperb_quad_ineq)
also have "... ≤ max (dist px py + dist y' x') (dist px x' + dist y' py) + 2 * delta"
using ‹deltaG(TYPE('a)) ≤ delta› by auto
finally have "2 * M - 10 * delta + 2 * dist x' y' ≤ max (dist px py + dist y' x') (dist px x' + dist y' py)"
by auto
then have "2 * M - 10 * delta + 2 * dist x' y' ≤ dist px x' + dist py y'"
apply (auto simp add: metric_space_class.dist_commute)
using ‹0 ≤ delta› ‹dist px py ≤ 2 * M - 10 * delta› ‹dist px x' = M› ‹dist py y' = M› by auto
then have "dist x' y' ≤ 5 * delta"
unfolding ‹dist px x' = M› ‹dist py y' = M› by auto
then show ?thesis
unfolding x'_def y'_def by auto
qed
text ‹The next lemma (Lemma 10 in~\cite{shchur} for $C = 0$) asserts that the projection on a geodesic segment is
an exponential contraction.
More precisely, if a path of length $L$ is at distance at least $D$ of a geodesic segment $G$,
then the projection of the path on $G$ has diameter at most $C L \exp(-c D/\delta)$, where $C$ and
$c$ are universal constants. This is not completely true at one can not go below a fixed size, as
always, so the correct bound is $K \max(\delta, L \exp(-c D/\delta))$. For the application, we
give a slightly more general statement involving an additional constant $C$.
This statement follows from the previous lemma: if one moves towards $G$ by $10 \delta$, then
the distance between points is divided by $2$. Then one iterates this statement as many times
as possible, gaining a factor $2$ each time and therefore an exponential factor in the end.›
lemma (in Gromov_hyperbolic_space_geodesic) geodesic_projection_exp_contracting:
assumes "geodesic_segment G"
"⋀x y. x ∈ {a..b} ⟹ y ∈ {a..b} ⟹ dist (f x) (f y) ≤ lambda * dist x y + C"
"a ≤ b"
"pa ∈ proj_set (f a) G"
"pb ∈ proj_set (f b) G"
"⋀t. t ∈ {a..b} ⟹ infdist (f t) G ≥ D"
"D ≥ 15/2 * delta + C/2"
"delta > deltaG(TYPE('a))"
"C ≥ 0"
"lambda ≥ 0"
shows "dist pa pb ≤ max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (b-a) * exp(-(D-C/2) * ln 2 / (5 * delta)))"
proof -
have "delta > 0" using assms
using local.delta_nonneg by linarith
have "exp(15/2/5 * ln 2) = exp(ln 2) * exp(1/2 * ln (2::real))"
unfolding mult_exp_exp by simp
also have "... = 2 * exp(1/2 * ln 2)"
by auto
finally have "exp(15/2/5 * ln 2) = 2 * exp(1/2 * ln (2::real))"
by simp
text ‹The idea of the proof is to start with a sequence of points separated by $10 \delta + C$ along
the original path, and push them by a fixed distance towards $G$ to bring them at distance at most
$5 \delta$, thanks to the previous lemma. Then, discard half the points, and start again. This
is possible while one is far enough from $G$. In the first step of the proof, we formalize this
in the case where the process can be iterated long enough that, at the end, the projections on $G$
are very close together. This is a simple induction, based on the previous lemma.›
have Main: "⋀c g p. (∀i ∈ {0..2^k}. p i ∈ proj_set (g i) G)
⟹ (∀i ∈ {0..2^k}. dist (p i) (g i) ≥ 5 * delta * k + 15/2 * delta + c/2)
⟹ (∀i ∈ {0..<2^k}. dist (g i) (g (Suc i)) ≤ 10 * delta + c)
⟹ c ≥ 0
⟹ dist (p 0) (p (2^k)) ≤ 5 * deltaG(TYPE('a))" for k
proof (induction k)
case 0
then have H: "p 0 ∈ proj_set (g 0) G"
"p 1 ∈ proj_set (g 1) G"
"dist (g 0) (g 1) ≤ 10 * delta + c"
"dist (p 0) (g 0) ≥ 15/2 * delta + c/2"
"dist (p 1) (g 1) ≥ 15/2 * delta + c/2"
by auto
have "dist (p 0) (p 1) ≤ max (5 * deltaG(TYPE('a))) (dist (g 0) (g 1) - dist (p 0) (g 0) - dist (p 1) (g 1) + 10 * deltaG(TYPE('a)))"
by (rule proj_along_geodesic_contraction[OF ‹geodesic_segment G› ‹p 0 ∈ proj_set (g 0) G› ‹p 1 ∈ proj_set (g 1) G›])
also have "... ≤ max (5 * deltaG(TYPE('a))) (5 * deltaG(TYPE('a)))"
apply (intro mono_intros) using H ‹delta > deltaG(TYPE('a))› by auto
finally show "dist (p 0) (p (2^0)) ≤ 5 * deltaG(TYPE('a))"
by auto
next
case (Suc k)
have *: "5 * delta * real (k + 1) + 5 * delta = 5 * delta * real (Suc k + 1)"
by (simp add: algebra_simps)
define h where "h = (λi. geodesic_segment_param {p i--g i} (p i) (5 * delta * k + 15/2 * delta))"
have h_dist: "dist (h i) (h (Suc i)) ≤ 5 * delta" if "i ∈ {0..<2^(Suc k)}" for i
unfolding h_def apply (rule geodesic_projection_exp_contracting_aux[OF ‹geodesic_segment G› _ _ less_imp_le[OF ‹delta > deltaG(TYPE('a))›]])
unfolding * using Suc.prems that ‹delta > 0› by (auto simp add: algebra_simps divide_simps)
define g' where "g' = (λi. h (2 * i))"
define p' where "p' = (λi. p (2 * i))"
have "dist (p' 0) (p' (2^k)) ≤ 5 * deltaG(TYPE('a))"
proof (rule Suc.IH[where ?g = g' and ?c = 0])
show "∀i∈{0..2 ^ k}. p' i ∈ proj_set (g' i) G"
proof
fix i::nat assume "i ∈ {0..2^k}"
then have *: "2 * i ∈ {0..2^(Suc k)}" by auto
show "p' i ∈ proj_set (g' i) G"
unfolding p'_def g'_def h_def apply (rule proj_set_geodesic_same_basepoint[of _ "g (2 * i)" _ "{p(2 * i)--g(2 * i)}"])
using Suc * by (auto simp add: geodesic_segment_param_in_segment)
qed
show "∀i∈{0..2 ^ k}. 5 * delta * k + 15/2 * delta + 0/2 ≤ dist (p' i) (g' i)"
proof
fix i::nat assume "i ∈ {0..2^k}"
then have *: "2 * i ∈ {0..2^(Suc k)}" by auto
have "5 * delta * k + 15/2 * delta ≤ 5 * delta * Suc k + 15/2 * delta + c/2"
using ‹delta > 0› ‹c ≥ 0› by (auto simp add: algebra_simps divide_simps)
also have "... ≤ dist (p (2 * i)) (g (2 * i))"
using Suc * by auto
finally have *: "5 * delta * k + 15/2 * delta ≤ dist (p (2 * i)) (g (2 * i))" by simp
have "dist (p' i) (g' i) = 5 * delta * k + 15/2 * delta"
unfolding p'_def g'_def h_def apply (rule geodesic_segment_param_in_geodesic_spaces(6))
using * ‹delta > 0› by auto
then show "5 * delta * k + 15/2 * delta + 0/2 ≤ dist (p' i) (g' i)" by simp
qed
show "∀i∈{0..<2 ^ k}. dist (g' i) (g' (Suc i)) ≤ 10 * delta + 0"
proof
fix i::nat assume *: "i ∈ {0..<2 ^ k}"
have "dist (g' i) (g' (Suc i)) = dist (h (2 * i)) (h (Suc (Suc (2 * i))))"
unfolding g'_def by auto
also have "... ≤ dist (h (2 * i)) (h (Suc (2 * i))) + dist (h (Suc (2 * i))) (h (Suc (Suc (2 * i))))"
by (intro mono_intros)
also have "... ≤ 5 * delta + 5 * delta"
apply (intro mono_intros h_dist) using * by auto
finally show "dist (g' i) (g' (Suc i)) ≤ 10 * delta + 0" by simp
qed
qed (simp)
then show "dist (p 0) (p (2 ^ Suc k)) ≤ 5 * deltaG(TYPE('a))"
unfolding p'_def by auto
qed
text ‹Now, we will apply the previous basic statement to points along our original path. We
introduce $k$, the number of steps for which the pushing process can be done -- it only depends on
the original distance $D$ to $G$. ›
define k where "k = nat(floor((D - C/2 - 15/2 * delta)/(5 * delta)))"
have "int k = floor((D - C/2 - 15/2 * delta)/(5 * delta))"
unfolding k_def apply (rule nat_0_le) using ‹D ≥ 15/2 * delta + C/2› ‹delta > 0› by auto
then have "k ≤ (D - C/2 - 15/2 * delta)/(5 * delta)" "(D - C/2 - 15/2 * delta)/(5 * delta) ≤ k + 1"
by linarith+
then have k: "D ≥ 5 * delta * k + 15/2 * delta + C/2" "D ≤ 5 * delta * (k+1) + 15/2 * delta + C/2"
using ‹delta > 0› by (auto simp add: algebra_simps divide_simps)
have "exp((D-C/2)/(5 * delta) * ln 2) * exp(-15/2/5 * ln 2) = exp(((D-C/2-15/2 * delta)/(5 * delta)) * ln 2)"
unfolding mult_exp_exp using ‹delta > 0› by (simp add: algebra_simps divide_simps)
also have "... ≤ exp((k+1) * ln 2)"
apply (intro mono_intros) using k(2) ‹delta > 0› by (auto simp add: divide_simps algebra_simps)
also have "... = 2^(k+1)"
by (subst powr_realpow[symmetric], auto simp add: powr_def)
also have "... = 2 * 2^k"
by auto
finally have k': "1/2^k ≤ 2 * exp(15/2/5 * ln 2) * exp(- ((D-C/2) * ln 2 / (5 * delta)))"
by (auto simp add: algebra_simps divide_simps exp_minus)
text ‹We separate the proof into two cases. If the path is not too long, then it can be covered by
$2^k$ points at distance at most $10 \delta + C$. By the basic statement, it follows that the diameter
of the projection is at most $5 \delta$. Otherwise, we subdivide the path into $2^N$ points at
distance at most $10 \delta + C$, with $N \geq k$, and apply the basic statement to blocks of $2^k$
consecutive points. It follows that the projections of $g_0, g_{2^k}, g_{2\cdot 2^k},\dotsc$ are
at distances at most $5 \delta$. Hence, the first and last projections are at distance at most
$2^{N-k} \cdot 5 \delta$, which is the desired bound.›
show ?thesis
proof (cases "lambda * (b-a) ≤ 10 * delta * 2^k")
text ‹First, treat the case where the path is rather short.›
case True
define g::"nat ⇒ 'a" where "g = (λi. f(a + (b-a) * i/2^k))"
have "g 0 = f a" "g(2^k) = f b"
unfolding g_def by auto
have *: "a + (b-a) * i/2^k ∈ {a..b}" if "i ∈ {0..2^k}" for i::nat
proof -
have "a + (b - a) * (real i / 2 ^ k) ≤ a + (b-a) * (2^k/2^k)"
apply (intro mono_intros) using that ‹a ≤ b› by auto
then show ?thesis using ‹a ≤ b› by auto
qed
have A: "dist (g i) (g (Suc i)) ≤ 10 * delta + C" if "i ∈ {0..<2^k}" for i
proof -
have "dist (g i) (g (Suc i)) ≤ lambda * dist (a + (b-a) * i/2^k) (a + (b-a) * (Suc i)/2^k) + C"
unfolding g_def apply (intro assms(2) *) using that by auto
also have "... = lambda * (b-a)/2^k + C"
unfolding dist_real_def using ‹a ≤ b› by (auto simp add: algebra_simps divide_simps)
also have "... ≤ 10 * delta + C"
using True by (simp add: divide_simps algebra_simps)
finally show ?thesis by simp
qed
define p where "p = (λi. if i = 0 then pa else if i = 2^k then pb else SOME p. p ∈ proj_set (g i) G)"
have B: "p i ∈ proj_set (g i) G" if "i ∈ {0..2^k}" for i
proof (cases "i = 0 ∨ i = 2^k")
case True
then show ?thesis
using ‹pa ∈ proj_set (f a) G› ‹pb ∈ proj_set (f b) G› unfolding p_def g_def by auto
next
case False
then have "p i = (SOME p. p ∈ proj_set (g i) G)"
unfolding p_def by auto
moreover have "proj_set (g i) G ≠ {}"
apply (rule proj_set_nonempty_of_proper) using geodesic_segment_topology[OF ‹geodesic_segment G›] by auto
ultimately show ?thesis
using some_in_eq by auto
qed
have C: "dist (p i) (g i) ≥ 5 * delta * k + 15/2 * delta + C/2" if "i ∈ {0..2^k}" for i
proof -
have "5 * delta * k + 15/2 * delta + C/2 ≤ D"
using k(1) by simp
also have "... ≤ infdist (g i) G"
unfolding g_def apply (rule ‹⋀t. t ∈ {a..b} ⟹ infdist (f t) G ≥ D›) using * that by auto
also have "... = dist (p i) (g i)"
using that proj_setD(2)[OF B[OF that]] by (simp add: metric_space_class.dist_commute)
finally show ?thesis by simp
qed
have "dist (p 0) (p (2^k)) ≤ 5 * deltaG(TYPE('a))"
apply (rule Main[where ?g = g and ?c = C]) using A B C ‹C ≥ 0› by auto
then show ?thesis
unfolding p_def by auto
next
text ‹Now, the case where the path is long. We introduce $N$ such that it is roughly of length
$2^N \cdot 10 \delta$.›
case False
have *: "10 * delta * 2^k ≤ lambda * (b-a)" using False by simp
have "lambda * (b-a) > 0"
using ‹delta > 0› False ‹0 ≤ lambda› assms(3) less_eq_real_def mult_le_0_iff by auto
then have "a < b" "lambda > 0"
using ‹a ≤ b› ‹lambda ≥ 0› less_eq_real_def by auto
define n where "n = nat(floor(log 2 (lambda * (b-a)/(10 * delta))))"
have "log 2 (lambda * (b-a)/(10 * delta)) ≥ log 2 (2^k)"
apply (subst log_le_cancel_iff)
using * ‹delta > 0› ‹a < b› ‹lambda > 0› by (auto simp add: divide_simps algebra_simps)
moreover have "log 2 (2^k) = k"
by simp
ultimately have A: "log 2 (lambda * (b-a)/(10 * delta)) ≥ k" by auto
have **: "int n = floor(log 2 (lambda * (b-a)/(10 * delta)))"
unfolding n_def apply (rule nat_0_le) using A by auto
then have "log 2 (2^n) ≤ log 2 (lambda * (b-a)/(10 * delta))"
apply (subst log_nat_power, auto) by linarith
then have I: "2^n ≤ lambda * (b-a)/(10 * delta)"
using ‹0 < lambda * (b - a)› ‹0 < delta›
by (simp add: le_log_iff powr_realpow)
have "log 2 (lambda * (b-a)/(10 * delta)) ≤ log 2 (2^(n+1))"
apply (subst log_nat_power, auto) using ** by linarith
then have J: "lambda * (b-a)/(10 * delta) ≤ 2^(n+1)"
using ‹0 < lambda * (b - a)› ‹0 < delta› by auto
have K: "k ≤ n" using A ** by linarith
define N where "N = n+1"
have N: "k+1 ≤ N" "lambda * (b-a) / 2^N ≤ 10 *delta" "2 ^ N ≤ lambda * (b - a) / (5 * delta)"
using I J K ‹delta > 0› unfolding N_def by (auto simp add: divide_simps algebra_simps)
then have "2 ^ k ≠ (0::real)" "k ≤ N"
by auto
then have "(2^(N-k)::real) = 2^N/2^k"
by (metis (no_types) add_diff_cancel_left' le_Suc_ex nonzero_mult_div_cancel_left power_add)
text ‹Define $2^N$ points along the path, separated by at most $10\delta$, and their projections.›
define g::"nat ⇒ 'a" where "g = (λi. f(a + (b-a) * i/2^N))"
have "g 0 = f a" "g(2^N) = f b"
unfolding g_def by auto
have *: "a + (b-a) * i/2^N ∈ {a..b}" if "i ∈ {0..2^N}" for i::nat
proof -
have "a + (b - a) * (real i / 2 ^ N) ≤ a + (b-a) * (2^N/2^N)"
apply (intro mono_intros) using that ‹a ≤ b› by auto
then show ?thesis using ‹a ≤ b› by auto
qed
have A: "dist (g i) (g (Suc i)) ≤ 10 * delta + C" if "i ∈ {0..<2^N}" for i
proof -
have "dist (g i) (g (Suc i)) ≤ lambda * dist (a + (b-a) * i/2^N) (a + (b-a) * (Suc i)/2^N) + C"
unfolding g_def apply (intro assms(2) *)
using that by auto
also have "... = lambda * (b-a)/2^N + C"
unfolding dist_real_def using ‹a ≤ b› by (auto simp add: algebra_simps divide_simps)
also have "... ≤ 10 * delta + C"
using N by simp
finally show ?thesis by simp
qed
define p where "p = (λi. if i = 0 then pa else if i = 2^N then pb else SOME p. p ∈ proj_set (g i) G)"
have B: "p i ∈ proj_set (g i) G" if "i ∈ {0..2^N}" for i
proof (cases "i = 0 ∨ i = 2^N")
case True
then show ?thesis
using ‹pa ∈ proj_set (f a) G› ‹pb ∈ proj_set (f b) G› unfolding p_def g_def by auto
next
case False
then have "p i = (SOME p. p ∈ proj_set (g i) G)"
unfolding p_def by auto
moreover have "proj_set (g i) G ≠ {}"
apply (rule proj_set_nonempty_of_proper) using geodesic_segment_topology[OF ‹geodesic_segment G›] by auto
ultimately show ?thesis
using some_in_eq by auto
qed
have C: "dist (p i) (g i) ≥ 5 * delta * k + 15/2 * delta + C/2" if "i ∈ {0..2^N}" for i
proof -
have "5 * delta * k + 15/2 * delta + C/2 ≤ D"
using k(1) by simp
also have "... ≤ infdist (g i) G"
unfolding g_def apply (rule ‹⋀t. t ∈ {a..b} ⟹ infdist (f t) G ≥ D›) using * that by auto
also have "... = dist (p i) (g i)"
using that proj_setD(2)[OF B[OF that]] by (simp add: metric_space_class.dist_commute)
finally show ?thesis by simp
qed
text ‹Use the basic statement to show that, along packets of size $2^k$, the projections
are within $5\delta$ of each other.›
have I: "dist (p (2^k * j)) (p (2^k * (Suc j))) ≤ 5 * delta" if "j ∈ {0..<2^(N-k)}" for j
proof -
have I: "i + 2^k * j ∈ {0..2^N}" if "i ∈ {0..2^k}" for i
proof -
have "i + 2 ^ k * j ≤ 2^k + 2^k * (2^(N-k)-1)"
apply (intro mono_intros) using that ‹j ∈ {0..<2^(N-k)}› by auto
also have "... = 2^N"
using ‹k +1 ≤ N› by (auto simp add: algebra_simps semiring_normalization_rules(26))
finally show ?thesis by auto
qed
have I': "i + 2^k * j ∈ {0..<2^N}" if "i ∈ {0..<2^k}" for i
proof -
have "i + 2 ^ k * j < 2^k + 2^k * (2^(N-k)-1)"
apply (intro mono_intros) using that ‹j ∈ {0..<2^(N-k)}› by auto
also have "... = 2^N"
using ‹k +1 ≤ N› by (auto simp add: algebra_simps semiring_normalization_rules(26))
finally show ?thesis by auto
qed
define g' where "g' = (λi. g (i + 2^k * j))"
define p' where "p' = (λi. p (i + 2^k * j))"
have "dist (p' 0) (p' (2^k)) ≤ 5 * deltaG(TYPE('a))"
apply (rule Main[where ?g = g' and ?c = C]) unfolding p'_def g'_def using A B C I I' ‹C ≥ 0› by auto
also have "... ≤ 5 * delta"
using ‹deltaG(TYPE('a)) < delta› by auto
finally show ?thesis
unfolding p'_def by auto
qed
text ‹Control the total distance by adding the contributions of blocks of size $2^k$.›
have *: "dist (p 0) (p(2^k * j)) ≤ (∑i<j. dist (p (2^k * i)) (p (2^k * (Suc i))))" for j
proof (induction j)
case (Suc j)
have "dist (p 0) (p(2^k * (Suc j))) ≤ dist (p 0) (p(2^k * j)) + dist (p(2^k * j)) (p(2^k * (Suc j)))"
by (intro mono_intros)
also have "... ≤ (∑i<j. dist (p (2^k * i)) (p (2^k * (Suc i)))) + dist (p(2^k * j)) (p(2^k * (Suc j)))"
using Suc.IH by auto
also have "... = (∑i<Suc j. dist (p (2^k * i)) (p (2^k * (Suc i))))"
by auto
finally show ?case by simp
qed (auto)
have "dist pa pb = dist (p 0) (p (2^N))"
unfolding p_def by auto
also have "... = dist (p 0) (p (2^k * 2^(N-k)))"
using ‹k +1 ≤ N› by (auto simp add: semiring_normalization_rules(26))
also have "... ≤ (∑i<2^(N-k). dist (p (2^k * i)) (p (2^k * (Suc i))))"
using * by auto
also have "... ≤ (∑(i::nat)<2^(N-k). 5 * delta)"
apply (rule sum_mono) using I by auto
also have "... = 5 * delta * 2^(N-k)"
by auto
also have "... = 5 * delta * 2^N * (1/ 2^k)"
unfolding ‹(2^(N-k)::real) = 2^N/2^k› by simp
also have "... ≤ 5 * delta * (2 * lambda * (b-a)/(10 * delta)) * (2 * exp(15/2/5 * ln 2) * exp(- ((D-C/2) * ln 2 / (5 * delta))))"
apply (intro mono_intros) using ‹delta > 0› ‹lambda > 0› ‹a < b› k' N by auto
also have "... = (2 * exp(15/2/5 * ln 2)) * lambda * (b-a) * exp(-(D-C/2) * ln 2 / (5 * delta))"
using ‹delta > 0› by (auto simp add: algebra_simps divide_simps)
finally show ?thesis
unfolding ‹exp(15/2/5 * ln 2) = 2 * exp(1/2 * ln (2::real))› by auto
qed
qed
text ‹We deduce from the previous result that a projection on a quasiconvex set is also
exponentially contracting. To do this, one uses the contraction of a projection on a geodesic, and
one adds up the additional errors due to the quasi-convexity. In particular, the projections on the
original quasiconvex set or the geodesic do not have to coincide, but they are within distance at
most $C + 8 \delta$.›
lemma (in Gromov_hyperbolic_space_geodesic) quasiconvex_projection_exp_contracting:
assumes "quasiconvex K G"
"⋀x y. x ∈ {a..b} ⟹ y ∈ {a..b} ⟹ dist (f x) (f y) ≤ lambda * dist x y + C"
"a ≤ b"
"pa ∈ proj_set (f a) G"
"pb ∈ proj_set (f b) G"
"⋀t. t ∈ {a..b} ⟹ infdist (f t) G ≥ D"
"D ≥ 15/2 * delta + K + C/2"
"delta > deltaG(TYPE('a))"
"C ≥ 0"
"lambda ≥ 0"
shows "dist pa pb ≤ 2 * K + 8 * delta + max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (b-a) * exp(-(D - K - C/2) * ln 2 / (5 * delta)))"
proof -
obtain H where H: "geodesic_segment_between H pa pb" "⋀q. q ∈ H ⟹ infdist q G ≤ K"
using quasiconvexD[OF assms(1) proj_setD(1)[OF ‹pa ∈ proj_set (f a) G›] proj_setD(1)[OF ‹pb ∈ proj_set (f b) G›]] by auto
obtain qa where qa: "qa ∈ proj_set (f a) H"
using proj_set_nonempty_of_proper[of H "f a"] geodesic_segment_topology[OF geodesic_segmentI[OF H(1)]] by auto
obtain qb where qb: "qb ∈ proj_set (f b) H"
using proj_set_nonempty_of_proper[of H "f b"] geodesic_segment_topology[OF geodesic_segmentI[OF H(1)]] by auto
have I: "infdist (f t) H ≥ D - K" if "t ∈ {a..b}" for t
proof -
have *: "D - K ≤ dist (f t) h" if "h ∈ H" for h
proof -
have "D - K - dist (f t) h ≤ e" if "e > 0" for e
proof -
have *: "infdist h G < K + e" using H(2)[OF ‹h ∈ H›] ‹e > 0› by auto
obtain g where g: "g ∈ G" "dist h g < K + e"
using infdist_almost_attained[OF *] proj_setD(1)[OF ‹pa ∈ proj_set (f a) G›] by auto
have "D ≤ dist (f t) g"
using ‹⋀t. t ∈ {a..b} ⟹ infdist (f t) G ≥ D›[OF ‹t ∈ {a..b}›] infdist_le[OF ‹g ∈ G›, of "f t"] by auto
also have "... ≤ dist (f t) h + dist h g"
by (intro mono_intros)
also have "... ≤ dist (f t) h + K + e"
using g(2) by auto
finally show ?thesis by auto
qed
then have *: "D - K - dist (f t) h ≤ 0"
using dense_ge by blast
then show ?thesis by simp
qed
have "D - K ≤ Inf (dist (f t) ` H)"
apply (rule cInf_greatest) using * H(1) by auto
then show "D - K ≤ infdist (f t) H"
apply (subst infdist_notempty) using H(1) by auto
qed
have Q: "dist qa qb ≤ max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (b-a) * exp(-((D - K)-C/2 ) * ln 2 / (5 * delta)))"
apply (rule geodesic_projection_exp_contracting[OF geodesic_segmentI[OF ‹geodesic_segment_between H pa pb›] assms(2) assms(3)])
using qa qb I assms by auto
have A: "dist pa qa ≤ 4 * delta + K"
proof -
have "dist (f a) pa - dist (f a) qa - K ≤ e" if "e > 0" for e::real
proof -
have *: "infdist qa G < K + e" using H(2)[OF proj_setD(1)[OF qa]] ‹e > 0› by auto
obtain g where g: "g ∈ G" "dist qa g < K + e"
using infdist_almost_attained[OF *] proj_setD(1)[OF ‹pa ∈ proj_set (f a) G›] by auto
have "dist (f a) pa ≤ dist (f a) g"
unfolding proj_setD(2)[OF ‹pa ∈ proj_set (f a) G›] using infdist_le[OF ‹g ∈ G›, of "f a"] by simp
also have "... ≤ dist (f a) qa + dist qa g"
by (intro mono_intros)
also have "... ≤ dist (f a) qa + K + e"
using g(2) by auto
finally show ?thesis by simp
qed
then have I: "dist (f a) pa - dist (f a) qa - K ≤ 0"
using dense_ge by blast
have "dist (f a) qa + dist qa pa ≤ dist (f a) pa + 4 * deltaG(TYPE('a))"
apply (rule dist_along_geodesic[OF geodesic_segmentI[OF H(1)]]) using qa H(1) by auto
also have "... ≤ dist (f a) qa + K + 4 * delta"
using I assms by auto
finally show ?thesis
by (simp add: metric_space_class.dist_commute)
qed
have B: "dist qb pb ≤ 4 * delta + K"
proof -
have "dist (f b) pb - dist (f b) qb - K ≤ e" if "e > 0" for e::real
proof -
have *: "infdist qb G < K + e" using H(2)[OF proj_setD(1)[OF qb]] ‹e > 0› by auto
obtain g where g: "g ∈ G" "dist qb g < K + e"
using infdist_almost_attained[OF *] proj_setD(1)[OF ‹pa ∈ proj_set (f a) G›] by auto
have "dist (f b) pb ≤ dist (f b) g"
unfolding proj_setD(2)[OF ‹pb ∈ proj_set (f b) G›] using infdist_le[OF ‹g ∈ G›, of "f b"] by simp
also have "... ≤ dist (f b) qb + dist qb g"
by (intro mono_intros)
also have "... ≤ dist (f b) qb + K + e"
using g(2) by auto
finally show ?thesis by simp
qed
then have I: "dist (f b) pb - dist (f b) qb - K ≤ 0"
using dense_ge by blast
have "dist (f b) qb + dist qb pb ≤ dist (f b) pb + 4 * deltaG(TYPE('a))"
apply (rule dist_along_geodesic[OF geodesic_segmentI[OF H(1)]]) using qb H(1) by auto
also have "... ≤ dist (f b) qb + K + 4 * delta"
using I assms by auto
finally show ?thesis
by simp
qed
have "dist pa pb ≤ dist pa qa + dist qa qb + dist qb pb"
by (intro mono_intros)
then show ?thesis
using Q A B by auto
qed
text ‹The next statement is the main step in the proof of the Morse-Gromov theorem given by Shchur
in~\cite{shchur}, asserting that a quasi-geodesic and a geodesic with the same endpoints are close.
We show that a point on the quasi-geodesic is close to the geodesic -- the other inequality will
follow easily later on. We also assume that the quasi-geodesic is parameterized by a Lipschitz map
-- the general case will follow as any quasi-geodesic can be approximated by a Lipschitz map with
good controls.
Here is a sketch of the proof. Fix two large constants $L \leq D$ (that we will choose carefully
to optimize the values of the constants at the end of the proof). Consider a quasi-geodesic $f$
between two points $f(u^-)$ and $f(u^+)$, and a geodesic segment $G$ between the same points.
Fix $f(z)$. We want to find a bound on $d(f(z), G)$.
1 - If this distance is smaller than $L$, we are done (and the bound is $L$).
2 - Assume it is larger.
Let $\pi_z$ be a projection of $f(z)$ on $G$ (at distance $d(f(z),G)$ of $f(z)$), and $H$ a geodesic
between $z$ and $\pi_z$. The idea will be to project the image of $f$ on $H$, and record how much
progress is made towards $f(z)$. In this proof, we will construct several points before and after
$z$. When necessary, we put an exponent $-$ on the points before $z$, and $+$ on the points after
$z$. To ease the reading, the points are ordered following the alphabetical order, i.e., $u^- \leq v
\leq w \leq x \leq y^- \leq z$.
One can find two points $f(y^-)$ and $f(y^+)$ on the left and the right of $f(z)$ that project
on $H$ roughly at distance $L$ of $\pi_z$ (up to some $O(\delta)$ -- recall that the closest point
projection is not uniquely defined, and not continuous, so we make some choice here).
Let $d^-$ be the minimal distance of $f([u^-, y^-])$ to $H$, and let $d^+$ be the minimal distance
of $f([y^+, u^+)]$ to $H$.
2.1 If the two distances $d^-$ and $d^+$ are less than $D$, then the distance between two points
realizing the minimum (say $f(c^-)$ and $f(c^+)$) is at most $2D+L$, hence $c^+ - c^-$ is controlled
(by $\lambda \cdot (2D+L) + C$) thanks to the quasi-isometry property. Therefore, $f(z)$ is not far
away from $f(c^-)$ and $f(c^+)$ (again by the quasi-isometry property). Since the distance from
these points to $\pi_z$ is controlled (by $D+L$), we get a good control on $d(f(z),\pi_z)$, as
desired.
2.2 The interesting case is when $d^-$ and $d^+$ are both $ > D$. Assume also for instance $d^- \geq
d^+$, as the other case is analogous. We will construct two points $f(v)$ and $f(x)$ with $u^- \leq
v \leq x \leq y^-$ with the following property:
\begin{equation}
\label{eq:xvK}
K_1 e^{K_2 d(f(v), H)} \leq x-v,
\end{equation}
where $K_1$ and $K_2$ are some explicit constants (depending on $\lambda$, $\delta$, $L$ and $D$).
Let us show how this will conclude the proof. The distance from $f(v)$ to $f(c^+)$ is at most
$d(f(v),H) + L + d^+ \leq 3 d(f(v), H)$. Therefore, $c^+ - v$ is also controlled by $K' d(f(v), H)$
by the quasi-isometry property. This gives
\begin{align*}
K &\leq K (x - v) e^{-K (c^+ - v)} \leq (e^{K (x-v)} - 1) \cdot e^{-K(c^+ - v)}
\\& = e^{-K (c^+ - x)} - e^{-K (c^+ - v)}
\leq e^{-K(c^+ - x)} - e^{-K (u^+ - u^-)}.
\end{align*}
This shows that, when one goes from the original quasi-geodesic $f([u^-, u^+])$ to the restricted
quasi-geodesic $f([x, c^+])$, the quantity $e^{-K \cdot}$ decreases by a fixed amount. In particular,
this process can only happen a uniformly bounded number of times, say $n$.
Let $G'$ be a geodesic between $f(x)$ and $f(c^+)$. One checks geometrically that $d(f(z), G) \leq
d(f(z), G') + (L + O(\delta))$, as both projections of $f(x)$ and $f(c^+)$ on $H$ are within
distance $L$ of $\pi_z$. Iterating the process $n$ times, one gets finally $d(f(z), G) \leq O(1) + n
(L + O(\delta))$. This is the desired bound for $d(f(z), G)$.
To complete the proof, it remains to construct the points $f(v)$ and $f(x)$ satisfying~\eqref{eq:xvK}.
This will be done through an inductive process.
Assume first that there is a point $f(v)$ whose projection on $H$ is close to the projection of
$f(u^-)$, and with $d(f(v), H) \leq 2 d^-$. Then the projections of $f(v)$ and $f(y^-)$ are far away
(at distance at least $L + O(\delta)$). Since the portion of $f$ between $v$ and $y^-$ is everywhere
at distance at least $d^-$ of $H$, the projection on $H$ contracts by a factor $e^{-d^-}$. It
follows that this portion of $f$ has length at least $e^{d^-} \cdot (L+O(\delta))$. Therefore, by
the quasi-isometry property, one gets $x - v \geq K e^{d^-}$. On the other hand, $d(v, H)$ is
bounded above by $2 d^-$ by assumption. This gives the desired inequality~\eqref{eq:xvK} with $x =
y^-$.
Otherwise, all points $f(v)$ whose projection on $H$ is close to the projection of $f(u^-)$ are such
that $d(f(v), H) \geq 2 d^-$. Consider $f(w_1)$ a point whose projection on $H$ is at distance
roughly $10 \delta$ of the projection of $f(u^-)$. Let $V_1$ be the set of points at distance at
most $d^-$ of $H$, i.e., the $d_1$-neighborhood of $H$. Then the distance between the projections of
$f(u^-)$ and $f(w_1)$ on $V_1$ is very large (are there is an additional big contraction to go from
$V_1$ to $H$). And moreover all the intermediate points $f(v)$ are at distance at least $2 d^-$ of
$H$, and therefore at distance at least $d^-$ of $H$. Then one can play the same game as in the
first case, where $y^-$ replaced by $w_1$ and $H$ replaced by $V_1$. If there is a point $f(v)$
whose projection on $V_1$ is close to the projection of $f(u^-)$, then the pair of points $v$ and $x
= w_1$ works. Otherwise, one lifts everything to $V_2$, the neighborhood of size $2d^-$ of $V_1$,
and one argues again in the same way.
The induction goes on like this until one finds a suitable pair of points. The process has indeed to
stop at one time, as it can only go on while $f(u^-)$ is outside of $V_k$, the $(2^k-1) d^-$
neighborhood of $H$). This concludes the sketch of the proof, modulo the adjustment of constants.
Comments on the formalization below:
\begin{itemize}
\item The proof is written as an induction on $u^+ - u^-$. This makes it possible to either prove
the bound directly (in the cases 1 and 2.1 above), or to use the bound on $d(z, G')$ in case 2.2
using the induction assumption, and conclude the proof. Of course, $u^+ - u^-$ is not integer-valued,
but in the reduction to $G'$ it decays by a fixed amount, so one can easily write this down as
a genuine induction.
\item The main difficulty in the proof is to construct the pair $(v, x)$ in case 2.2. This is again
written as an induction over $k$: either the required bound is true, or one can find a point $f(w)$
whose projection on $V_k$ is far enough from the projection of $f(u^-)$. Then, either one can use
this point to prove the bound, or one can construct a point with the same property with respect to
$V_{k+1}$, concluding the induction.
\item Instead of writing $u^-$ and $u^+$ (which are not good variable names in Isabelle), we write
$um$ and $uM$. Similarly for other variables.
\item The proof only works when $\delta > 0$ (as one needs to divide by $\delta$
in the exponential gain). Hence, we formulate it for some $\delta$ which is
strictly larger than the hyperbolicity constant. In a subsequent application of
the lemma, we will deduce the same statement for the hyperbolicity constant
by a limiting argument.
\item To optimize the value of the constant in the end, there is an additional important trick with
respect to the above sketch: in case 2.2, there is an exponential gain. One can spare a fraction
$(1-\alpha)$ of this gain to improve the constants, and spend the remaining fraction $\alpha$ to
make the argument work. This makes it possible to reduce the value of the constant roughly from
$40000$ to $100$, so we do it in the proof below. The values of $L$, $D$ and $\alpha$ can be chosen
freely, and have been chosen to get the best possible constant in the end.
\item For another optimization, we do not induce in terms of the distance from $f(z)$ to the geodesic
$G$, but rather in terms of the Gromov product $(f(u^-), f(u^+))_{f(z)}$ (which is the same up to
$O(\delta)$. And we do not take for $H$ a geodesic from $f(z)$ to its projection on $G$, but rather
a geodesic from $f(z)$ to the point $m$ on $[f(u^-), f(u^+)]$ opposite to $f(z)$ in the tripod, i.e.,
at distance $(f(z), f(u^+))_{f(u^-)}$ of $f(u^-)$, and at distance $(f(z), f(u^-))_{f(u^+)}$ of
$f(u^+)$. Let $\pi_z$ denote the point on $[f(z), m]$ at distance $(f(u^-), f(u^+)_{f(z)}$ of $f(z)$.
(It is within distance $2 \delta$ of $m$).
In both approaches, what we want to control by induction is the distance from $f(z)$ to $\pi_z$.
However, in the first approach, the points $f(u^-)$ and $f(u^+)$ project on $H$ between $\pi_z$ and
$f(z)$, and since the location of their projection is only controlled up to $4\delta$ one loses
essentially a $4\delta$-length of $L$ for the forthcoming argument. In the second approach, the
projections on $H$ are on the other side of $\pi_z$ compared to $f(z)$, so one does not lose
anything, and in the end it gives genuinely better bounds (making it possible to gain roughly
$10 \delta$ in the final estimate).
\end{itemize}
›
lemma (in Gromov_hyperbolic_space_geodesic) Morse_Gromov_theorem_aux1:
fixes f::"real ⇒ 'a"
assumes "continuous_on {a..b} f"
"lambda C-quasi_isometry_on {a..b} f"
"a ≤ b"
"geodesic_segment_between G (f a) (f b)"
"z ∈ {a..b}"
"delta > deltaG(TYPE('a))"
shows "infdist (f z) G ≤ lambda^2 * (11/2 * C + 91 * delta)"
proof -
have "C ≥ 0" "lambda ≥ 1" using quasi_isometry_onD assms by auto
have "delta > 0" using assms delta_nonneg order_trans by linarith
text ‹We give their values to the parameters $L$, $D$ and $\alpha$ that we will use in the proof.
We also define two constants $K$ and $K_{mult}$ that appear in the precise formulation of the
bounds. Their values have no precise meaning, they are just the outcome of the computation›
define alpha::real where "alpha = 12/100"
have alphaaux:"alpha > 0" "alpha ≤ 1" unfolding alpha_def by auto
define L::real where "L = 18 * delta"
define D::real where "D = 55 * delta"
define K where "K = alpha * ln 2 / (5 * (4 + (L + 2 * delta)/D) * delta * lambda)"
have "K > 0" "L > 0" "D > 0" unfolding K_def L_def D_def using ‹delta > 0› ‹lambda ≥ 1› alpha_def by auto
have Laux: "L ≥ 18 * delta" "D ≥ 50 * delta" "L ≤ D" "D ≤ 4 * L" unfolding L_def D_def using ‹delta > 0› by auto
have Daux: "8 * delta ≤ (1 - alpha) * D" unfolding alpha_def D_def using ‹delta > 0› by auto
define Kmult where "Kmult = ((L + 4 * delta)/(L - 13 * delta)) * ((4 * exp(1/2 * ln 2)) * lambda * exp (- (1 - alpha) * D * ln 2 / (5 * delta)) / K)"
have "Kmult > 0" unfolding Kmult_def using Laux ‹delta > 0› ‹K > 0› ‹lambda ≥ 1› by (auto simp add: divide_simps)
text ‹We prove that, for any pair of points to the left and to the right of $f(z)$, the distance
from $f(z)$ to a geodesic between these points is controlled. We prove this by reducing to a
closer pair of points, i.e., this is an inductive argument over real numbers. However, we
formalize it as an artificial induction over natural numbers, as this is how induction works
best, and since in our reduction step the new pair of points is always significantly closer
than the initial one, at least by an amount $\delta/\lambda$.
The main inductive bound that we will prove is the following. In this bound, the first term is
what comes from the trivial cases 1 and 2.1 in the description of the proof before the statement
of the theorem, while the most interesting term is the second term, corresponding to the induction
per se.›
have Main: "⋀um uM. um ∈ {a..z} ⟹ uM ∈ {z..b}
⟹ uM - um ≤ n * (1/4) * delta / lambda
⟹ Gromov_product_at (f z) (f um) (f uM) ≤ lambda^2 * (D + (3/2) * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (uM - um)))"
for n::nat
proof (induction n)
text ‹Trivial base case of the induction›
case 0
then have *: "z = um" "z = uM" by auto
then have "Gromov_product_at (f z) (f um) (f uM) = 0" by auto
also have "... ≤ 1 * (D + (3/2) * L + delta + 11/2 * C) - 2 * delta + 0 * (1 - exp(- K * (uM - um)))"
using Laux ‹C ≥ 0› ‹delta > 0› by auto
also have "... ≤ lambda^2 * (D + (3/2) * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (uM - um)))"
apply (intro mono_intros)
using ‹C ≥ 0› ‹delta > 0› Laux ‹D > 0› ‹K > 0› "0.prems" ‹lambda ≥ 1› ‹Kmult > 0› by auto
finally show ?case by auto
next
case (Suc n)
show ?case
proof (cases "Gromov_product_at (f z) (f um) (f uM) ≤ L")
text ‹If $f(z)$ is already close to the geodesic, there is nothing to do, and we do not need
the induction assumption. This is case 1 in the description above.›
case True
have "L ≤ 1 * (D + (3/2) * L + delta + 11/2 * C) - 2 * delta + 0 * (1 - exp(- K * (uM - um)))"
using Laux ‹C ≥ 0› ‹delta > 0› by auto
also have "... ≤ lambda^2 * (D + (3/2) * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (uM - um)))"
apply (intro mono_intros)
using ‹C ≥ 0› ‹delta > 0› Laux ‹D > 0› "Suc.prems" ‹K > 0› ‹lambda ≥ 1› ‹Kmult > 0› by auto
finally show ?thesis using True by auto
next
text ‹We come to the interesting case where $f(z)$ is far away from a geodesic between
$f(um)$ and $f(uM)$. Let $m$ be close to a projection of $f(z)$ on such a geodesic (we use
the opposite point of $f(z)$ on the corresponding tripod). On a geodesic between $f(z)$ and $m$,
consider the point $pi_z$ at distance $(f(um), f(uM))_{f(z)}$ of $f(z)$. It is very close to
$m$ (within distance $2 \delta$). We will push the points $f(um)$ and $f(uM)$
towards $f(z)$ by considering points whose projection on a geodesic $H$ between $m$ and
$z$ is roughly at distance $L$ of $pi_z$.›
case False
define m where "m = geodesic_segment_param {f um--f uM} (f um) (Gromov_product_at (f um) (f z) (f uM))"
have "dist (f z) m ≤ Gromov_product_at (f z) (f um) (f uM) + 2 * deltaG(TYPE('a))"
unfolding m_def by (rule dist_triangle_side_middle, auto)
then have *: "dist (f z) m ≤ Gromov_product_at (f z) (f um) (f uM) + 2 * delta"
using ‹deltaG(TYPE('a)) < delta› by auto
have "Gromov_product_at (f z) (f um) (f uM) ≤ infdist (f z) {f um--f uM}"
by (intro mono_intros, auto)
also have "... ≤ dist (f z) m"
apply (rule infdist_le) unfolding m_def by auto
finally have **: "Gromov_product_at (f z) (f um) (f uM) ≤ dist (f z) m"
by auto
define H where "H = {f z--m}"
define pi_z where "pi_z = geodesic_segment_param H (f z) (Gromov_product_at (f z) (f um) (f uM))"
have "pi_z ∈ H" "m ∈ H" "f z ∈ H"
unfolding pi_z_def H_def by (auto simp add: geodesic_segment_param_in_segment)
have H: "geodesic_segment_between H (f z) m"
unfolding H_def by auto
have Dpi_z: "dist (f z) pi_z = Gromov_product_at (f z) (f um) (f uM)"
unfolding pi_z_def H_def by (rule geodesic_segment_param(6)[where ?y = m], auto simp add: **)
moreover have "dist (f z) m = dist (f z) pi_z + dist pi_z m"
apply (rule geodesic_segment_dist[of H, symmetric]) using ‹pi_z ∈ H› unfolding H_def by auto
ultimately have "dist pi_z m ≤ 2 * delta"
using * by auto
text ‹Introduce the notation $p$ for some projection on the geodesic $H$.›
define p where "p = (λr. SOME x. x ∈ proj_set (f r) H)"
have p: "p x ∈ proj_set (f x) H" for x
unfolding p_def using proj_set_nonempty_of_proper[of H "f x"] geodesic_segment_topology[OF geodesic_segmentI[OF H]]
by (simp add: some_in_eq)
then have pH: "p x ∈ H" for x
using proj_setD(1) by auto
have pz: "p z = f z"
using p[of z] H by auto
text ‹The projection of $f(um)$ on $H$ is close to $pi_z$ (but it does not have to be exactly
$pi_z$). It is between $pi_z$ and $m$.›
have "dist (f um) (f z) ≤ dist (f um) (p um) + dist (p um) (f z)"
by (intro mono_intros)
also have "... ≤ dist (f um) m + dist (p um) (f z)"
unfolding proj_setD(2)[OF p[of um]] H_def by (auto intro!: infdist_le)
also have "... = Gromov_product_at (f um) (f z) (f uM) + dist (p um) (f z)"
unfolding m_def by simp
finally have A: "Gromov_product_at (f z) (f um) (f uM) ≤ dist (p um) (f z)"
unfolding Gromov_product_at_def by (simp add: metric_space_class.dist_commute divide_simps)
have "dist (p um) pi_z = abs(dist (p um) (f z) - dist pi_z (f z))"
apply (rule dist_along_geodesic_wrt_endpoint[of H _ m]) using pH ‹pi_z ∈ H› H_def by auto
also have "... = dist (p um) (f z) - dist pi_z (f z)"
using A Dpi_z by (simp add: metric_space_class.dist_commute)
finally have Dum: "dist (p um) (f z) = dist (p um) pi_z + dist pi_z (f z)" by auto
text ‹Choose a point $f(ym)$ whose projection on $H$ is roughly at distance $L$ of $pi_z$.›
have "∃ym ∈ {um..z}. (dist (p um) (p ym) ∈ {(L + dist pi_z (p um)) - 4 * delta - 2 * 0 .. L + dist pi_z (p um)})
∧ (∀r ∈ {um..ym}. dist (p um) (p r) ≤ L + dist pi_z (p um))"
proof (rule quasi_convex_projection_small_gaps[where ?f = f and ?G = H])
show "continuous_on {um..z} f"
apply (rule continuous_on_subset[OF ‹continuous_on {a..b} f›])
using ‹um ∈ {a..z}› ‹z ∈ {a..b}› by auto
show "um ≤ z" using ‹um ∈ {a..z}› by auto
show "quasiconvex 0 H" using quasiconvex_of_geodesic geodesic_segmentI H by auto
show "deltaG TYPE('a) < delta" by fact
have "L + dist pi_z (p um) ≤ dist (f z) pi_z + dist pi_z (p um)"
using False Dpi_z by (simp add: metric_space_class.dist_commute)
then have "L + dist pi_z (p um) ≤ dist (p um) (f z)"
using Dum by (simp add: metric_space_class.dist_commute)
then show "L + dist pi_z (p um) ∈ {4 * delta + 2 * 0..dist (p um) (p z)}"
using ‹delta > 0› False L_def pz by auto
show "p ym ∈ proj_set (f ym) H" for ym using p by simp
qed
then obtain ym where ym : "ym ∈ {um..z}"
"dist (p um) (p ym) ∈ {(L + dist pi_z (p um)) - 4 * delta - 2 * 0 .. L + dist pi_z (p um)}"
"⋀r. r ∈ {um..ym} ⟹ dist (p um) (p r) ≤ L + dist pi_z (p um)"
by blast
have *: "continuous_on {um..ym} (λr. infdist (f r) H)"
using continuous_on_infdist[OF continuous_on_subset[OF ‹continuous_on {a..b} f›, of "{um..ym}"], of H]
‹ym ∈ {um..z}› ‹um ∈ {a..z}› ‹z ∈ {a..b}› by auto
text ‹Choose a point $cm$ between $f(um)$ and $f(ym)$ realizing the minimal distance to $H$.
Call this distance $dm$.›
have "∃closestm ∈ {um..ym}. ∀v ∈ {um..ym}. infdist (f closestm) H ≤ infdist (f v) H"
apply (rule continuous_attains_inf) using ym(1) * by auto
then obtain closestm where closestm: "closestm ∈ {um..ym}" "⋀v. v ∈ {um..ym} ⟹ infdist (f closestm) H ≤ infdist (f v) H"
by auto
define dm where "dm = infdist (f closestm) H"
have [simp]: "dm ≥ 0" unfolding dm_def using infdist_nonneg by auto
text ‹Same things but in the interval $[z, uM]$.›
have I: "dist m (f uM) = dist (f um) (f uM) - dist (f um) m"
"dist (f um) m = Gromov_product_at (f um) (f z) (f uM)"
using geodesic_segment_dist[of "{f um--f uM}" "f um" "f uM" m] m_def by auto
have "dist (f uM) (f z) ≤ dist (f uM) (p uM) + dist (p uM) (f z)"
by (intro mono_intros)
also have "... ≤ dist (f uM) m + dist (p uM) (f z)"
unfolding proj_setD(2)[OF p[of uM]] H_def by (auto intro!: infdist_le)
also have "... = Gromov_product_at (f uM) (f z) (f um) + dist (p uM) (f z)"
using I unfolding Gromov_product_at_def by (simp add: divide_simps algebra_simps metric_space_class.dist_commute)
finally have A: "Gromov_product_at (f z) (f um) (f uM) ≤ dist (p uM) (f z)"
unfolding Gromov_product_at_def by (simp add: metric_space_class.dist_commute divide_simps)
have "dist (p uM) pi_z = abs(dist (p uM) (f z) - dist pi_z (f z))"
apply (rule dist_along_geodesic_wrt_endpoint[of H _ m]) using pH ‹pi_z ∈ H› H_def by auto
also have "... = dist (p uM) (f z) - dist pi_z (f z)"
using A Dpi_z by (simp add: metric_space_class.dist_commute)
finally have DuM: "dist (p uM) (f z) = dist (p uM) pi_z + dist pi_z (f z)" by auto
text ‹Choose a point $f(yM)$ whose projection on $H$ is roughly at distance $L$ of $pi_z$.›
have "∃yM ∈ {z..uM}. dist (p uM) (p yM) ∈ {(L + dist pi_z (p uM)) - 4* delta - 2 * 0 .. L + dist pi_z (p uM)}
∧ (∀r ∈ {yM..uM}. dist (p uM) (p r) ≤ L + dist pi_z (p uM))"
proof (rule quasi_convex_projection_small_gaps'[where ?f = f and ?G = H])
show "continuous_on {z..uM} f"
apply (rule continuous_on_subset[OF ‹continuous_on {a..b} f›])
using ‹uM ∈ {z..b}› ‹z ∈ {a..b}› by auto
show "z ≤ uM" using ‹uM ∈ {z..b}› by auto
show "quasiconvex 0 H" using quasiconvex_of_geodesic geodesic_segmentI H by auto
show "deltaG TYPE('a) < delta" by fact
have "L + dist pi_z (p uM) ≤ dist (f z) pi_z + dist pi_z (p uM)"
using False Dpi_z by (simp add: metric_space_class.dist_commute)
then have "L + dist pi_z (p uM) ≤ dist (p uM) (f z)"
using DuM by (simp add: metric_space_class.dist_commute)
then show "L + dist pi_z (p uM) ∈ {4 * delta + 2 * 0..dist (p z) (p uM)}"
using ‹delta > 0› False L_def pz by (auto simp add: metric_space_class.dist_commute)
show "p yM ∈ proj_set (f yM) H" for yM using p by simp
qed
then obtain yM where yM: "yM ∈ {z..uM}"
"dist (p uM) (p yM) ∈ {(L + dist pi_z (p uM)) - 4* delta - 2 * 0 .. L + dist pi_z (p uM)}"
"⋀r. r ∈ {yM..uM} ⟹ dist (p uM) (p r) ≤ L + dist pi_z (p uM)"
by blast
have *: "continuous_on {yM..uM} (λr. infdist (f r) H)"
using continuous_on_infdist[OF continuous_on_subset[OF ‹continuous_on {a..b} f›, of "{yM..uM}"], of H]
‹yM ∈ {z..uM}› ‹uM ∈ {z..b}› ‹z ∈ {a..b}› by auto
have "∃closestM ∈ {yM..uM}. ∀v ∈ {yM..uM}. infdist (f closestM) H ≤ infdist (f v) H"
apply (rule continuous_attains_inf) using yM(1) * by auto
then obtain closestM where closestM: "closestM ∈ {yM..uM}" "⋀v. v ∈ {yM..uM} ⟹ infdist (f closestM) H ≤ infdist (f v) H"
by auto
define dM where "dM = infdist (f closestM) H"
have [simp]: "dM ≥ 0" unfolding dM_def using infdist_nonneg by auto
text ‹Points between $f(um)$ and $f(ym)$, or between $f(yM)$ and $f(uM)$, project within
distance at most $L$ of $pi_z$ by construction.›
have P0: "dist m (p x) ≤ dist m pi_z + L" if "x ∈ {um..ym} ∪ {yM..uM}" for x
proof (cases "x ∈ {um..ym}")
case True
have "dist m (f z) = dist m (p um) + dist (p um) pi_z + dist pi_z (f z)"
using geodesic_segment_dist[OF H pH[of um]] Dum by (simp add: metric_space_class.dist_commute)
moreover have "dist m (f z) = dist m pi_z + dist pi_z (f z)"
using geodesic_segment_dist[OF H ‹pi_z ∈ H›] by (simp add: metric_space_class.dist_commute)
ultimately have *: "dist m pi_z = dist m (p um) + dist (p um) pi_z" by auto
have "dist (p um) (p x) ≤ L + dist pi_z (p um)"
using ym(3)[OF ‹x ∈ {um..ym}›] by blast
then show ?thesis
using metric_space_class.dist_triangle[of m "p x" "p um"] * by (auto simp add: metric_space_class.dist_commute)
next
case False
then have "x ∈ {yM..uM}" using that by auto
have "dist m (f z) = dist m (p uM) + dist (p uM) pi_z + dist pi_z (f z)"
using geodesic_segment_dist[OF H pH[of uM]] DuM by (simp add: metric_space_class.dist_commute)
moreover have "dist m (f z) = dist m pi_z + dist pi_z (f z)"
using geodesic_segment_dist[OF H ‹pi_z ∈ H›] by (simp add: metric_space_class.dist_commute)
ultimately have *: "dist m pi_z = dist m (p uM) + dist (p uM) pi_z" by auto
have "dist (p uM) (p x) ≤ L + dist pi_z (p uM)"
using yM(3)[OF ‹x ∈ {yM..uM}›] by blast
then show ?thesis
using metric_space_class.dist_triangle[of m "p x" "p uM"] * by (auto simp add: metric_space_class.dist_commute)
qed
have P: "dist pi_z (p x) ≤ L" if "x ∈ {um..ym} ∪ {yM..uM}" for x
proof (cases "dist m (p x) ≤ dist pi_z m")
case True
have "dist pi_z (p x) ≤ dist pi_z m + dist m (p x)"
by (intro mono_intros)
also have "... ≤ 2 * delta + 2 * delta"
using ‹dist pi_z m ≤ 2 * delta› True by auto
finally show ?thesis
using Laux ‹delta > 0› by auto
next
case False
have "dist pi_z (p x) = abs(dist pi_z m - dist (p x) m)"
apply (rule dist_along_geodesic_wrt_endpoint[OF geodesic_segment_commute[OF H]])
using pH ‹pi_z ∈ H› by auto
also have "... = dist (p x) m - dist pi_z m"
using False by (simp add: metric_space_class.dist_commute)
finally show ?thesis
using P0[OF that] by (simp add: metric_space_class.dist_commute)
qed
text ‹Auxiliary fact for later use:
The distance between two points in $[um, ym]$ and $[yM, uM]$ can be controlled using
the distances of their images under $f$ to $H$, thanks to the quasi-isometry property.›
have D: "dist rm rM ≤ lambda * (infdist (f rm) H + (L + C + 2 * delta) + infdist (f rM) H)"
if "rm ∈ {um..ym}" "rM ∈ {yM..uM}" for rm rM
proof -
have *: "dist m (p rm) ≤ L + dist m pi_z" "dist m (p rM) ≤ L + dist m pi_z"
using P0 that by force+
have "dist (p rm) (p rM) = abs(dist (p rm) m - dist (p rM) m)"
apply (rule dist_along_geodesic_wrt_endpoint[OF geodesic_segment_commute[OF H]])
using pH by auto
also have "... ≤ L + dist m pi_z"
unfolding abs_le_iff using * apply (auto simp add: metric_space_class.dist_commute)
by (metis diff_add_cancel le_add_same_cancel1 metric_space_class.zero_le_dist order_trans)+
finally have *: "dist (p rm) (p rM) ≤ L + 2 * delta"
using ‹dist pi_z m ≤ 2 * delta› by (simp add: metric_space_class.dist_commute)
have "(1/lambda) * dist rm rM - C ≤ dist (f rm) (f rM)"
apply (rule quasi_isometry_onD(2)[OF ‹lambda C-quasi_isometry_on {a..b} f›])
using ‹rm ∈ {um..ym}› ‹ym ∈ {um..z}› ‹um ∈ {a..z}› ‹z ∈ {a..b}› ‹rM ∈ {yM..uM}› ‹yM ∈ {z..uM}› ‹uM ∈ {z..b}› by auto
also have "... ≤ dist (f rm) (p rm) + dist (p rm) (p rM) + dist (p rM) (f rM)"
by (intro mono_intros)
also have "... ≤ infdist (f rm) H + L + 2 * delta + infdist (f rM) H"
using * proj_setD(2)[OF p] by (simp add: metric_space_class.dist_commute)
finally show ?thesis
using ‹lambda ≥ 1› by (simp add: algebra_simps divide_simps)
qed
text ‹Auxiliary fact for later use in the inductive argument:
the distance from $f(z)$ to $pi_z$ is controlled by the distance from $f(z)$ to any
intermediate geodesic between points in $f[um, ym]$ and $f[yM, uM]$, up to a constant
essentially given by $L$. This is a variation around Lemma 5 in~\cite{shchur}.›
have Rec: "Gromov_product_at (f z) (f um) (f uM) ≤ Gromov_product_at (f z) (f rm) (f rM) + (L + 4 * delta)" if "rm ∈ {um..ym}" "rM ∈ {yM..uM}" for rm rM
proof -
have *: "dist (f rm) (p rm) + dist (p rm) (f z) ≤ dist (f rm) (f z) + 4 * deltaG(TYPE('a))"
apply (rule dist_along_geodesic[of H]) using p H_def by auto
have "dist (f z) pi_z ≤ dist (f z) (p rm) + dist (p rm) pi_z"
by (intro mono_intros)
also have "... ≤ (Gromov_product_at (f z) (f rm) (p rm) + 2 * deltaG(TYPE('a))) + L"
apply (intro mono_intros) using * P ‹rm ∈ {um..ym}› unfolding Gromov_product_at_def
by (auto simp add: metric_space_class.dist_commute algebra_simps divide_simps)
finally have A: "dist (f z) pi_z - L - 2 * deltaG(TYPE('a)) ≤ Gromov_product_at (f z) (f rm) (p rm)"
by simp
have *: "dist (f rM) (p rM) + dist (p rM) (f z) ≤ dist (f rM) (f z) + 4 * deltaG(TYPE('a))"
apply (rule dist_along_geodesic[of H]) using p H_def by auto
have "dist (f z) pi_z ≤ dist (f z) (p rM) + dist (p rM) pi_z"
by (intro mono_intros)
also have "... ≤ (Gromov_product_at (f z) (p rM) (f rM) + 2 * deltaG(TYPE('a))) + L"
apply (intro mono_intros) using * P ‹rM ∈ {yM..uM}› unfolding Gromov_product_at_def
by (auto simp add: metric_space_class.dist_commute algebra_simps divide_simps)
finally have B: "dist (f z) pi_z - L - 2 * deltaG(TYPE('a)) ≤ Gromov_product_at (f z) (p rM) (f rM)"
by simp
have C: "dist (f z) pi_z - L - 2 * deltaG(TYPE('a)) ≤ Gromov_product_at (f z) (p rm) (p rM)"
proof (cases "dist (f z) (p rm) ≤ dist (f z) (p rM)")
case True
have "dist (p rm) (p rM) = abs(dist (f z) (p rm) - dist (f z) (p rM))"
using proj_setD(1)[OF p] dist_along_geodesic_wrt_endpoint[OF H, of "p rm" "p rM"]
by (simp add: metric_space_class.dist_commute)
also have "... = dist (f z) (p rM) - dist (f z) (p rm)"
using True by auto
finally have *: "dist (f z) (p rm) = Gromov_product_at (f z) (p rm) (p rM)"
unfolding Gromov_product_at_def by auto
have "dist (f z) pi_z ≤ dist (f z) (p rm) + dist (p rm) pi_z"
by (intro mono_intros)
also have "... ≤ Gromov_product_at (f z) (p rm) (p rM) + L + 2 * deltaG(TYPE('a))"
using * P[of rm] ‹rm ∈ {um..ym}› apply (simp add: metric_space_class.dist_commute)
using local.delta_nonneg by linarith
finally show ?thesis by simp
next
case False
have "dist (p rm) (p rM) = abs(dist (f z) (p rm) - dist (f z) (p rM))"
using proj_setD(1)[OF p] dist_along_geodesic_wrt_endpoint[OF H, of "p rm" "p rM"]
by (simp add: metric_space_class.dist_commute)
also have "... = dist (f z) (p rm) - dist (f z) (p rM)"
using False by auto
finally have *: "dist (f z) (p rM) = Gromov_product_at (f z) (p rm) (p rM)"
unfolding Gromov_product_at_def by auto
have "dist (f z) pi_z ≤ dist (f z) (p rM) + dist (p rM) pi_z"
by (intro mono_intros)
also have "... ≤ Gromov_product_at (f z) (p rm) (p rM) + L + 2 * deltaG(TYPE('a))"
using * P[of rM] ‹rM ∈ {yM..uM}› apply (simp add: metric_space_class.dist_commute)
using local.delta_nonneg by linarith
finally show ?thesis by simp
qed
have "Gromov_product_at (f z) (f um) (f uM) - L - 2 * deltaG(TYPE('a)) ≤ Min {Gromov_product_at (f z) (f rm) (p rm), Gromov_product_at (f z) (p rm) (p rM), Gromov_product_at (f z) (p rM) (f rM)}"
using A B C unfolding Dpi_z by auto
also have "... ≤ Gromov_product_at (f z) (f rm) (f rM) + 2 * deltaG(TYPE('a))"
by (intro mono_intros)
finally show ?thesis
using ‹deltaG(TYPE('a)) < delta› by auto
qed
text ‹We have proved the basic facts we will need in the main argument. This argument starts
here. It is divided in several cases.›
consider "dm ≤ D + 4 * C ∧ dM ≤ D + 4 * C" | "dm ≥ D + 4 * C ∧ dM ≤ dm" | "dM ≥ D + 4 * C ∧ dm ≤ dM"
by linarith
then show ?thesis
proof (cases)
text ‹Case 2.1 of the description before the statement: there are points in $f[um, ym]$ and
in $f[yM, uM]$ which are close to $H$. Then one can conclude directly, without relying
on the inductive argument, thanks to the quasi-isometry property.›
case 1
have I: "Gromov_product_at (f z) (f closestm) (f closestM) ≤ lambda^2 * (D + L / 2 + delta + 11/2 * C) - 6 * delta"
proof (cases "dist (f closestm) (f closestM) ≤ 12 * delta")
case True
have "1/lambda * dist closestm closestM - C ≤ dist (f closestm) (f closestM)"
using quasi_isometry_onD(2)[OF assms(2)] ‹closestm ∈ {um..ym}› ‹um ∈ {a..z}› ‹z ∈ {a..b}› ‹ym ∈ {um..z}›
‹closestM ∈ {yM..uM}› ‹uM ∈ {z..b}› ‹z ∈ {a..b}› ‹yM ∈ {z..uM}› by auto
then have "dist closestm closestM ≤ lambda * dist (f closestm) (f closestM) + lambda * C"
using ‹lambda ≥ 1› by (auto simp add: divide_simps algebra_simps)
also have "... ≤ lambda * (12 * delta) + lambda * C"
apply (intro mono_intros True) using ‹lambda ≥ 1› by auto
finally have M: "dist closestm closestM ≤ lambda * (12 * delta + C)"
by (auto simp add: algebra_simps)
have "2 * Gromov_product_at (f z) (f closestm) (f closestM) ≤ dist (f closestm) (f z) + dist (f z) (f (closestM))"
unfolding Gromov_product_at_def by (auto simp add: metric_space_class.dist_commute)
also have "... ≤ (lambda * dist closestm z + C) + (lambda * dist z closestM + C)"
apply (intro mono_intros quasi_isometry_onD(1)[OF assms(2)])
using ‹closestm ∈ {um..ym}› ‹um ∈ {a..z}› ‹z ∈ {a..b}› ‹ym ∈ {um..z}›
‹closestM ∈ {yM..uM}› ‹uM ∈ {z..b}› ‹z ∈ {a..b}› ‹yM ∈ {z..uM}› by auto
also have "... = lambda * dist closestm closestM + 1 * 2 * C"
unfolding dist_real_def using ‹closestm ∈ {um..ym}› ‹um ∈ {a..z}› ‹z ∈ {a..b}› ‹ym ∈ {um..z}›
‹closestM ∈ {yM..uM}› ‹uM ∈ {z..b}› ‹z ∈ {a..b}› ‹yM ∈ {z..uM}› by (auto simp add: algebra_simps)
also have "... ≤ lambda * (lambda * (12 * delta + C)) + lambda^2 * 2 * C"
apply (intro mono_intros M) using ‹lambda ≥ 1› ‹C ≥ 0› by auto
also have "... = lambda^2 * (24 * delta + 3 * C) - lambda^2 * 12 * delta"
by (simp add: algebra_simps power2_eq_square)
also have "... ≤ lambda^2 * ((2 * D + L + 2 * delta) + 11 * C) - 1 * 12 * delta"
apply (intro mono_intros) using Laux ‹lambda ≥ 1› ‹C ≥ 0› ‹delta > 0› by auto
finally show ?thesis
by (auto simp add: divide_simps algebra_simps)
next
case False
have "dist closestm closestM ≤ lambda * (dm + dM + L + 2 * delta + C)"
using D[OF ‹closestm ∈ {um..ym}› ‹closestM ∈ {yM..uM}›] dm_def dM_def by (auto simp add: algebra_simps)
also have "... ≤ lambda * ((D + 4 * C) + (D + 4 * C) + L + 2 * delta + C)"
apply (intro mono_intros) using 1 ‹lambda ≥ 1› by auto
also have "... ≤ lambda * (2 * D + L + 2 * delta + 9 * C)"
using ‹lambda ≥ 1› ‹C ≥ 0› by auto
finally have M: "dist closestm closestM ≤ lambda * (2 * D + L + 2 * delta + 9 * C)"
by (auto simp add: algebra_simps divide_simps metric_space_class.dist_commute)
have "dist (f closestm) (f z) + dist (f z) (f (closestM)) ≤ (lambda * dist closestm z + C) + (lambda * dist z closestM + C)"
apply (intro mono_intros quasi_isometry_onD(1)[OF assms(2)])
using ‹closestm ∈ {um..ym}› ‹um ∈ {a..z}› ‹z ∈ {a..b}› ‹ym ∈ {um..z}›
‹closestM ∈ {yM..uM}› ‹uM ∈ {z..b}› ‹z ∈ {a..b}› ‹yM ∈ {z..uM}› by auto
also have "... = lambda * dist closestm closestM + 1 * 2 * C"
unfolding dist_real_def using ‹closestm ∈ {um..ym}› ‹um ∈ {a..z}› ‹z ∈ {a..b}› ‹ym ∈ {um..z}›
‹closestM ∈ {yM..uM}› ‹uM ∈ {z..b}› ‹z ∈ {a..b}› ‹yM ∈ {z..uM}› by (auto simp add: algebra_simps)
also have "... ≤ lambda * (lambda * (2 * D + L + 2 * delta + 9 * C)) + lambda^2 * 2 * C"
apply (intro mono_intros M) using ‹lambda ≥ 1› ‹C ≥ 0› by auto
finally have "dist (f closestm) (f z) + dist (f z) (f closestM) ≤ lambda^2 * (2 * D + L + 2 * delta + 11 * C)"
by (simp add: algebra_simps power2_eq_square)
then show ?thesis
unfolding Gromov_product_at_def using False by (simp add: metric_space_class.dist_commute algebra_simps divide_simps)
qed
have "Gromov_product_at (f z) (f um) (f uM) ≤ Gromov_product_at (f z) (f closestm) (f closestM) + 1 * L + 4 * delta + 0 * (1 - exp (- K * (uM - um)))"
using Rec[OF ‹closestm ∈ {um..ym}› ‹closestM ∈ {yM..uM}›] by simp
also have "... ≤ (lambda^2 * (D + L / 2 + delta + 11/2 * C) - 6 * delta) + lambda^2 * L + 4 * delta + Kmult * (1 - exp (- K * (uM - um)))"
apply (intro mono_intros I)
using Laux ‹lambda ≥ 1› ‹delta > 0› ‹Kmult > 0› ‹um ∈ {a..z}› ‹uM ∈ {z..b}› ‹K > 0› by auto
finally show ?thesis
by (simp add: algebra_simps)
text ‹End of the easy case 2.1›
next
text ‹Case 2.2: $dm$ is large, i.e., all points in $f[um, ym]$ are far away from $H$. Moreover,
assume that $dm \geq dM$. Then we will find a pair of points $v$ and $x$ with $um \leq v
\leq x \leq ym$ satisfying the estimate~\eqref{eq:xvK}. We argue by induction: while we
have not found such a pair, we can find a point $x_k$ whose projection on $V_k$, the
neighborhood of size $(2^k-1) dm$ of $H$, is far enough from the projection of $um$, and
such that all points in between are far enough from $V_k$ so that the corresponding
projection will have good contraction properties.›
case 2
then have I: "D + 4 * C ≤ dm" "dM ≤ dm" by auto
define V where "V = (λk::nat. (⋃g∈H. cball g ((2^k - 1) * dm)))"
define QC where "QC = (λk::nat. if k = 0 then 0 else 8 * delta)"
have "QC k ≥ 0" for k unfolding QC_def using ‹delta > 0› by auto
have Q: "quasiconvex (0 + 8 * deltaG(TYPE('a))) (V k)" for k
unfolding V_def apply (rule quasiconvex_thickening) using geodesic_segmentI[OF H]
by (auto simp add: quasiconvex_of_geodesic)
have "quasiconvex (QC k) (V k)" for k
apply (cases "k = 0")
apply (simp add: V_def QC_def quasiconvex_of_geodesic geodesic_segmentI[OF H])
apply (rule quasiconvex_mono[OF _ Q[of k]]) using ‹deltaG(TYPE('a)) < delta› QC_def by auto
text ‹Define $q(k, x)$ to be the projection of $f(x)$ on $V_k$.›
define q::"nat ⇒ real ⇒ 'a" where "q = (λk x. geodesic_segment_param {p x--f x} (p x) ((2^k - 1) * dm))"
text ‹The inductive argument›
have Ind_k: "(Gromov_product_at (f z) (f um) (f uM) ≤ lambda^2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (uM - um))))
∨ (∃x ∈ {um..ym}. (∀w ∈ {um..x}. dist (f w) (p w) ≥ (2^(k+1)-1) * dm) ∧ dist (q k um) (q k x) ≥ L - 4 * delta + 7 * QC k)" for k
proof (induction k)
text ‹Base case: there is a point far enough from $q 0 um$ on $H$. This is just the point $ym$,
by construction.›
case 0
have *: "∃x∈ {um..ym}. (∀w ∈ {um..x}. dist (f w) (p w) ≥ (2^(0+1)-1) * dm) ∧ dist (q 0 um) (q 0 x) ≥ L - 4 * delta + 7 * QC 0"
proof (rule bexI[of _ ym], auto simp add: V_def q_def QC_def)
show "um ≤ ym" using ‹ym ∈ {um..z}› by auto
show "L - 4 * delta ≤ dist (p um) (p ym)"
using ym(2) apply auto using metric_space_class.zero_le_dist[of pi_z "p um"] by linarith
show "⋀y. um ≤ y ⟹ y ≤ ym ⟹ dm ≤ dist (f y) (p y)"
using dm_def closestm proj_setD(2)[OF p] by auto
qed
then show ?case
by blast
next
text ‹The induction. The inductive assumption claims that, either the desired inequality
holds, or one can construct a point with good properties. If the desired inequality holds,
there is nothing left to prove. Otherwise, we can start from this point at step $k$,
say $x$, and either prove the desired inequality or construct a point with the good
properties at step $k+1$.›
case Suck: (Suc k)
show ?case
proof (cases "Gromov_product_at (f z) (f um) (f uM) ≤ lambda⇧2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp (- K * (uM - um)))")
case True
then show ?thesis by simp
next
case False
then obtain x where x: "x ∈ {um..ym}" "dist (q k um) (q k x) ≥ L - 4 * delta + 7 * QC k"
"⋀w. w ∈ {um..x} ⟹ dist (f w) (p w) ≥ (2^(k+1)-1) * dm"
using Suck.IH by auto
text ‹Some auxiliary technical inequalities to be used later on.›
have aux: "(2 ^ k - 1) * dm ≤ (2*2^k-1) * dm" "0 ≤ 2 * 2 ^ k - (1::real)" "dm ≤ dm * 2 ^ k"
apply (auto simp add: algebra_simps)
apply (metis power.simps(2) two_realpow_ge_one)
using ‹0 ≤ dm› less_eq_real_def by fastforce
have "L + C = (L/D) * (D + (D/L) * C)"
using ‹L > 0› ‹D > 0› by (simp add: algebra_simps divide_simps)
also have "... ≤ (L/D) * (D + 4 * C)"
apply (intro mono_intros)
using ‹L > 0› ‹D > 0› ‹C ≥ 0› ‹D ≤ 4 * L› by (auto simp add: algebra_simps divide_simps)
also have "... ≤ (L/D) * dm"
apply (intro mono_intros) using I ‹L > 0› ‹D > 0› by auto
finally have "L + C ≤ (L/D) * dm"
by simp
moreover have "2 * delta ≤ (2 * delta)/D * dm"
using I ‹C ≥ 0› ‹delta > 0› ‹D > 0› by (auto simp add: algebra_simps divide_simps)
ultimately have aux2: "L + C + 2 * delta ≤ ((L + 2 * delta)/D) * dm"
by (auto simp add: algebra_simps divide_simps)
have aux3: "(1-alpha) * D + alpha * 2^k * dm ≤ dm * 2^k - C/2 - QC k"
proof (cases "k = 0")
case True
show ?thesis
using I ‹C ≥ 0› unfolding True QC_def alpha_def by auto
next
case False
have "C/2 + QC k + (1-alpha) * D ≤ 2 * (1-alpha) * dm"
using I ‹C ≥ 0› unfolding QC_def alpha_def using False Laux by auto
also have "... ≤ 2^k * (1-alpha) * dm"
apply (intro mono_intros) using False alphaaux I ‹D > 0› ‹C ≥ 0› by auto
finally show ?thesis
by (simp add: algebra_simps)
qed
text ‹Construct a point $w$ such that its projection on $V_k$ is close to that of $um$
and therefore far away from that of $x$. This is just the intermediate value theorem
(with some care as the closest point projection is not continuous).›
have "∃w ∈ {um..x}. (dist (q k um) (q k w) ∈ {(9 * delta + 4 * QC k) - 4 * delta - 2 * QC k .. 9 * delta + 4 * QC k})
∧ (∀v ∈ {um..w}. dist (q k um) (q k v) ≤ 9 * delta + 4 * QC k)"
proof (rule quasi_convex_projection_small_gaps[where ?f = f and ?G = "V k"])
show "continuous_on {um..x} f"
apply (rule continuous_on_subset[OF ‹continuous_on {a..b} f›])
using ‹um ∈ {a..z}› ‹z ∈ {a..b}› ‹ym ∈ {um..z}› ‹x ∈ {um..ym}› by auto
show "um ≤ x" using ‹x ∈ {um..ym}› by auto
show "quasiconvex (QC k) (V k)" by fact
show "deltaG TYPE('a) < delta" by fact
show "9 * delta + 4 * QC k ∈ {4 * delta + 2 * QC k..dist (q k um) (q k x)}"
using x(2) ‹delta > 0› ‹QC k ≥ 0› Laux by auto
show "q k w ∈ proj_set (f w) (V k)" if "w ∈ {um..x}" for w
unfolding V_def q_def apply (rule proj_set_thickening)
using aux p x(3)[OF that] by (auto simp add: metric_space_class.dist_commute)
qed
then obtain w where w: "w ∈ {um..x}"
"dist (q k um) (q k w) ∈ {(9 * delta + 4 * QC k) - 4 * delta - 2 * QC k .. 9 * delta + 4 * QC k}"
"⋀v. v ∈ {um..w} ⟹ dist (q k um) (q k v) ≤ 9 * delta + 4 * QC k"
by auto
text ‹There are now two cases to be considered: either one can find a point $v$ between
$um$ and $w$ which is close enough to $H$. Then this point will satisfy~\eqref{eq:xvK},
and we will be able to prove the desired inequality. Or there is no such point,
and then $w$ will have the good properties at step $k+1$›
show ?thesis
proof (cases "∃v ∈ {um..w}. dist (f v) (p v) ≤ (2^(k+2)-1) * dm")
case True
text ‹First subcase: there is a good point $v$ between $um$ and $w$. This is the
heart of the argument: we will show that the desired inequality holds.›
then obtain v where v: "v ∈ {um..w}" "dist (f v) (p v) ≤ (2^(k+2)-1) * dm"
by auto
text ‹Auxiliary basic fact to be used later on.›
have aux4: "dm * 2 ^ k ≤ infdist (f r) (V k)" if "r ∈ {v..x}" for r
proof -
have *: "q k r ∈ proj_set (f r) (V k)"
unfolding q_def V_def apply (rule proj_set_thickening)
using aux p[of r] x(3)[of r] that ‹v ∈ {um..w}› ‹w ∈ {um..x}› by (auto simp add: metric_space_class.dist_commute)
have "infdist (f r) (V k) = dist (geodesic_segment_param {p r--f r} (p r) (dist (p r) (f r))) (geodesic_segment_param {p r--f r} (p r) ((2 ^ k - 1) * dm))"
using proj_setD(2)[OF *] unfolding q_def by auto
also have "... = abs(dist (p r) (f r) - (2 ^ k - 1) * dm)"
apply (rule geodesic_segment_param(7)[where ?y = "f r"])
using x(3)[of r] ‹r ∈ {v..x}› ‹v ∈ {um..w}› ‹w ∈ {um..x}› aux by (auto simp add: metric_space_class.dist_commute)
also have "... = dist (f r) (p r) - (2 ^ k - 1) * dm"
using x(3)[of r] ‹r ∈ {v..x}› ‹v ∈ {um..w}› ‹w ∈ {um..x}› aux by (auto simp add: metric_space_class.dist_commute)
finally have "dist (f r) (p r) = infdist (f r) (V k) + (2 ^ k - 1) * dm" by simp
moreover have "(2^(k+1) - 1) * dm ≤ dist (f r) (p r)"
apply (rule x(3)) using ‹r ∈ {v..x}› ‹v ∈ {um..w}› ‹w ∈ {um..x}› by auto
ultimately have "(2^(k+1) - 1) * dm ≤ infdist (f r) (V k) + (2 ^ k - 1) * dm"
by simp
then show ?thesis by (auto simp add: algebra_simps)
qed
text ‹Substep 1: We can control the distance from $f(v)$ to $f(closestM)$ in terms of the distance
of the distance of $f(v)$ to $H$, i.e., by $2^k dm$. The same control follows
for $closestM - v$ thanks to the quasi-isometry property. Then, we massage this
inequality to put it in the form we will need, as an upper bound on $(x-v) \exp(-2^k dm)$.›
have "infdist (f v) H ≤ (2^(k+2)-1) * dm"
using v proj_setD(2)[OF p[of v]] by auto
have "dist v closestM ≤ lambda * (infdist (f v) H + (L + C + 2 * delta) + infdist (f closestM) H)"
apply (rule D)
using ‹v ∈ {um..w}› ‹w ∈ {um..x}› ‹x ∈ {um..ym}› ‹ym ∈ {um..z}› ‹um ∈ {a..z}› ‹z ∈ {a..b}› ‹closestM ∈ {yM..uM}› ‹yM ∈ {z..uM}› ‹uM ∈ {z..b}› by auto
also have "... ≤ lambda * ((2^(k+2)-1) * dm + 1 * (L + C + 2 * delta) + dM)"
apply (intro mono_intros ‹infdist (f v) H ≤ (2^(k+2)-1) * dm›)
using dM_def ‹lambda ≥ 1› ‹L > 0› ‹C ≥ 0› ‹delta > 0› by (auto simp add: metric_space_class.dist_commute)
also have "... ≤ lambda * ((2^(k+2)-1) * dm + 2^k * (((L + 2 * delta)/D) * dm) + dm)"
apply (intro mono_intros) using I ‹lambda ≥ 1› ‹C ≥ 0› ‹delta > 0› ‹L > 0› aux2 by auto
also have "... = lambda * 2^k * (4 + (L + 2 * delta)/D) * dm"
by (simp add: algebra_simps)
finally have *: "dist v closestM / (lambda * (4 + (L + 2 * delta)/D)) ≤ 2^k * dm"
using ‹lambda ≥ 1› ‹L > 0› ‹D > 0› ‹delta > 0› by (simp add: divide_simps, simp add: algebra_simps)
text ‹We reformulate this control inside of an exponential, as this is the form we
will use later on.›
have "exp(- (alpha * (2^k * dm) * ln 2 / (5 * delta))) ≤ exp(-(alpha * (dist v closestM / (lambda * (4 + (L + 2 * delta)/D))) * ln 2 / (5 * delta)))"
apply (intro mono_intros *) using alphaaux ‹delta > 0› by auto
also have "... = exp(-K * dist v closestM)"
unfolding K_def by (simp add: divide_simps)
also have "... = exp(-K * (closestM - v))"
unfolding dist_real_def using ‹v ∈ {um..w}› ‹w ∈ {um..x}› ‹x ∈ {um..ym}› ‹ym ∈ {um..z}› ‹yM ∈ {z..uM}› ‹closestM ∈ {yM..uM}› ‹K > 0› by auto
finally have "exp(- (alpha * (2^k * dm) * ln 2 / (5 * delta))) ≤ exp(-K * (closestM - v))"
by simp
text ‹Plug in $x-v$ to get the final form of this inequality.›
then have "K * (x - v) * exp(- (alpha * (2^k * dm) * ln 2 / (5 * delta))) ≤ K * (x - v) * exp(-K * (closestM - v))"
apply (rule mult_left_mono)
using ‹delta > 0› ‹lambda ≥ 1› ‹v ∈ {um..w}› ‹w ∈ {um..x}› ‹K > 0› by auto
also have "... = ((1 + K * (x - v)) - 1) * exp(- K * (closestM - v))"
by (auto simp add: algebra_simps)
also have "... ≤ (exp (K * (x - v)) - 1) * exp(-K * (closestM - v))"
by (intro mono_intros, auto)
also have "... = exp(-K * (closestM - x)) - exp(-K * (closestM - v))"
by (simp add: algebra_simps mult_exp_exp)
also have "... ≤ exp(-K * (closestM - x)) - exp(-K * (uM - um))"
using ‹K > 0› ‹v ∈ {um..w}› ‹w ∈ {um..x}› ‹x ∈ {um..ym}› ‹ym ∈ {um..z}› ‹yM ∈ {z..uM}› ‹closestM ∈ {yM..uM}› by auto
finally have B: "(x - v) * exp(- alpha * 2^k * dm * ln 2 / (5 * delta)) ≤
(exp(-K * (closestM - x)) - exp(-K * (uM-um)))/K"
using ‹K > 0› by (auto simp add: divide_simps algebra_simps)
text ‹End of substep 1›
text ‹Substep 2: The projections of $f(v)$ and $f(x)$ on the cylinder $V_k$ are well separated,
by construction. This implies that $v$ and $x$ themselves are well separated, thanks
to the exponential contraction property of the projection on the quasi-convex set $V_k$.
This leads to a uniform lower bound for $(x-v) \exp(-2^k dm)$, which has been upper bounded
in Substep 1.›
have "L - 4 * delta + 7 * QC k ≤ dist (q k um) (q k x)"
using x by simp
also have "... ≤ dist (q k um) (q k v) + dist (q k v) (q k x)"
by (intro mono_intros)
also have "... ≤ (9 * delta + 4 * QC k) + dist (q k v) (q k x)"
using w(3)[of v] ‹v ∈ {um..w}› by auto
finally have "L - 13 * delta + 3 * QC k ≤ dist (q k v) (q k x)"
by simp
also have "... ≤ 3 * QC k + max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (x - v) * exp(-(dm * 2^k - C/2 - QC k) * ln 2 / (5 * delta)))"
proof (cases "k = 0")
text ‹We use different statements for the projection in the case $k = 0$ (projection on
a geodesic) and $k > 0$ (projection on a quasi-convex set) as the bounds are better in
the first case, which is the most important one for the final value of the constant.›
case True
have "dist (q k v) (q k x) ≤ max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (x - v) * exp(-(dm * 2^k - C/2) * ln 2 / (5 * delta)))"
proof (rule geodesic_projection_exp_contracting[where ?G = "V k" and ?f = f])
show "geodesic_segment (V k)" unfolding True V_def using geodesic_segmentI[OF H] by auto
show "v ≤ x" using ‹v ∈ {um..w}› ‹w ∈ {um..x}› by auto
show "q k v ∈ proj_set (f v) (V k)"
unfolding q_def V_def apply (rule proj_set_thickening)
using aux p[of v] x(3)[of v] ‹v ∈ {um..w}› ‹w ∈ {um..x}› by (auto simp add: metric_space_class.dist_commute)
show "q k x ∈ proj_set (f x) (V k)"
unfolding q_def V_def apply (rule proj_set_thickening)
using aux p[of x] x(3)[of x] ‹w ∈ {um..x}› by (auto simp add: metric_space_class.dist_commute)
show "15/2 * delta + C/2 ≤ dm * 2^k"
apply (rule order_trans[of _ dm])
using I ‹delta > 0› ‹C ≥ 0› Laux unfolding QC_def by auto
show "deltaG TYPE('a) < delta" by fact
show "⋀t. t ∈ {v..x} ⟹ dm * 2 ^ k ≤ infdist (f t) (V k)"
using aux4 by auto
show "0 ≤ C" "0 ≤ lambda" using ‹C ≥ 0› ‹lambda ≥ 1› by auto
show "dist (f x1) (f x2) ≤ lambda * dist x1 x2 + C" if "x1 ∈ {v..x}" "x2 ∈ {v..x}" for x1 x2
using quasi_isometry_onD(1)[OF assms(2)] that ‹v ∈ {um..w}› ‹w ∈ {um..x}› ‹x ∈ {um..ym}› ‹ym ∈ {um..z}› ‹um ∈ {a..z}› ‹z ∈ {a..b}› by auto
qed
then show ?thesis unfolding QC_def True by auto
next
case False
have "dist (q k v) (q k x) ≤ 2 * QC k + 8 * delta + max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (x - v) * exp(-(dm * 2^k - QC k -C/2) * ln 2 / (5 * delta)))"
proof (rule quasiconvex_projection_exp_contracting[where ?G = "V k" and ?f = f])
show "quasiconvex (QC k) (V k)" by fact
show "v ≤ x" using ‹v ∈ {um..w}› ‹w ∈ {um..x}› by auto
show "q k v ∈ proj_set (f v) (V k)"
unfolding q_def V_def apply (rule proj_set_thickening)
using aux p[of v] x(3)[of v] ‹v ∈ {um..w}› ‹w ∈ {um..x}› by (auto simp add: metric_space_class.dist_commute)
show "q k x ∈ proj_set (f x) (V k)"
unfolding q_def V_def apply (rule proj_set_thickening)
using aux p[of x] x(3)[of x] ‹w ∈ {um..x}› by (auto simp add: metric_space_class.dist_commute)
show "15/2 * delta + QC k + C/2 ≤ dm * 2^k"
apply (rule order_trans[of _ dm])
using I ‹delta > 0› ‹C ≥ 0› Laux unfolding QC_def by auto
show "deltaG TYPE('a) < delta" by fact
show "⋀t. t ∈ {v..x} ⟹ dm * 2 ^ k ≤ infdist (f t) (V k)"
using aux4 by auto
show "0 ≤ C" "0 ≤ lambda" using ‹C ≥ 0› ‹lambda ≥ 1› by auto
show "dist (f x1) (f x2) ≤ lambda * dist x1 x2 + C" if "x1 ∈ {v..x}" "x2 ∈ {v..x}" for x1 x2
using quasi_isometry_onD(1)[OF assms(2)] that ‹v ∈ {um..w}› ‹w ∈ {um..x}› ‹x ∈ {um..ym}› ‹ym ∈ {um..z}› ‹um ∈ {a..z}› ‹z ∈ {a..b}› by auto
qed
then show ?thesis unfolding QC_def using False by (auto simp add: algebra_simps)
qed
finally have "L - 13 * delta ≤ max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (x - v) * exp(-(dm * 2^k - C/2 - QC k) * ln 2 / (5 * delta)))"
by auto
then have "L - 13 * delta ≤ (4 * exp(1/2 * ln 2)) * lambda * (x - v) * exp(-(dm * 2^k - C/2 - QC k) * ln 2 / (5 * delta))"
using ‹delta > deltaG(TYPE('a))› Laux by auto
text ‹We separate the exponential gain coming from the contraction into two parts, one
to be spent to improve the constant, and one for the inductive argument.›
also have "... ≤ (4 * exp(1/2 * ln 2)) * lambda * (x - v) * exp(-((1-alpha) * D + alpha * 2^k * dm) * ln 2 / (5 * delta))"
apply (intro mono_intros) using aux3 ‹delta > 0› ‹lambda ≥ 1› ‹v ∈ {um..w}› ‹w ∈ {um..x}› by auto
also have "... = (4 * exp(1/2 * ln 2)) * lambda * (x - v) * (exp(-(1-alpha) * D * ln 2 / (5 * delta)) * exp(-alpha * 2^k * dm * ln 2 / (5 * delta)))"
unfolding mult_exp_exp by (auto simp add: algebra_simps divide_simps)
finally have A: "L - 13 * delta ≤ (4 * exp(1/2 * ln 2)) * lambda * exp(-(1-alpha) * D * ln 2 / (5 * delta)) * ((x - v) * exp(-alpha * 2^k * dm * ln 2 / (5 * delta)))"
by (simp add: algebra_simps)
text ‹This is the end of the second substep.›
text ‹Use the second substep to show that $x-v$ is bounded below, and therefore
that $closestM - x$ (the endpoints of the new geodesic we want to consider in the
inductive argument) are quantitatively closer than $uM - um$, which means that we
will be able to use the inductive assumption over this new geodesic.›
also have "... ≤ (4 * exp(1/2 * ln 2)) * lambda * exp 0 * ((x - v) * exp 0)"
apply (intro mono_intros) using ‹delta > 0› ‹lambda ≥ 1› ‹v ∈ {um..w}› ‹w ∈ {um..x}› alphaaux ‹D > 0› ‹C ≥ 0› I
by (auto simp add: divide_simps mult_nonpos_nonneg)
also have "... = (4 * exp(1/2 * ln 2)) * lambda * (x-v)"
by simp
also have "... ≤ 20 * lambda * (x - v)"
apply (intro mono_intros, approximation 10)
using ‹delta > 0› ‹lambda ≥ 1› ‹v ∈ {um..w}› ‹w ∈ {um..x}› by auto
finally have "x - v ≥ (1/4) * delta / lambda"
using ‹lambda ≥ 1› L_def ‹delta > 0› by (simp add: divide_simps algebra_simps)
then have "closestM - x + (1/4) * delta / lambda ≤ closestM - v"
by simp
also have "... ≤ uM - um"
using ‹closestM ∈ {yM..uM}› ‹v ∈ {um..w}› by auto
also have "... ≤ Suc n * (1/4) * delta / lambda" by fact
finally have "closestM - x ≤ n * (1/4) * delta / lambda"
unfolding Suc_eq_plus1 by (auto simp add: algebra_simps add_divide_distrib)
text ‹Conclusion of the proof: combine the lower bound of the second substep with
the upper bound of the first substep to get a definite gain when one goes from
the old geodesic to the new one. Then, apply the inductive assumption to the new one
to conclude the desired inequality for the old one.›
have "L + 4 * delta = ((L + 4 * delta)/(L - 13 * delta)) * (L - 13 * delta)"
using Laux ‹delta > 0› by (simp add: algebra_simps divide_simps)
also have "... ≤ ((L + 4 * delta)/(L - 13 * delta)) * ((4 * exp(1/2 * ln 2)) * lambda * exp (- (1 - alpha) * D * ln 2 / (5 * delta)) * ((x - v) * exp (- alpha * 2 ^ k * dm * ln 2 / (5 * delta))))"
apply (rule mult_left_mono) using A Laux ‹delta > 0› by (auto simp add: divide_simps)
also have "... ≤ ((L + 4 * delta)/(L - 13 * delta)) * ((4 * exp(1/2 * ln 2)) * lambda * exp (- (1 - alpha) * D * ln 2 / (5 * delta)) * ((exp(-K * (closestM - x)) - exp(-K * (uM - um)))/K))"
apply (intro mono_intros B) using Laux ‹delta > 0› ‹lambda ≥ 1› by (auto simp add: divide_simps)
finally have C: "L + 4 * delta ≤ Kmult * (exp(-K * (closestM - x)) - exp(-K * (uM - um)))"
unfolding Kmult_def by auto
have "Gromov_product_at (f z) (f um) (f uM) ≤ Gromov_product_at (f z) (f x) (f closestM) + (L + 4 * delta)"
apply (rule Rec) using ‹closestM ∈ {yM..uM}› ‹x ∈ {um..ym}› ‹ym ∈ {um..z}› by auto
also have "... ≤ (lambda^2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (closestM - x)))) + (Kmult * (exp(-K * (closestM - x)) - exp(-K * (uM-um))))"
apply (intro mono_intros C Suc.IH)
using ‹x ∈ {um..ym}› ‹ym ∈ {um..z}› ‹um ∈ {a..z}› ‹closestM ∈ {yM..uM}› ‹yM ∈ {z..uM}› ‹uM ∈ {z..b}› ‹closestM - x ≤ n * (1/4) * delta / lambda› by auto
also have "... = (lambda^2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (uM - um))))"
unfolding K_def by (simp add: algebra_simps)
finally show ?thesis by auto
text ‹End of the first subcase, when there is a good point $v$ between $um$ and $w$.›
next
case False
text ‹Second subcase: between $um$ and $w$, all points are far away from $V_k$. We
will show that this implies that $w$ is admissible for the step $k+1$.›
have "∃w∈{um..ym}. (∀v∈{um..w}. (2 ^ (Suc k + 1) - 1) * dm ≤ dist (f v) (p v)) ∧ L - 4 * delta + 7 * QC (Suc k) ≤ dist (q (Suc k) um) (q (Suc k) w)"
proof (rule bexI[of _ w], auto)
show "um ≤ w" "w ≤ ym" using ‹w ∈ {um..x}› ‹x ∈ {um..ym}› by auto
show "(4 * 2 ^ k - 1) * dm ≤ dist (f x) (p x)" if "um ≤ x" "x ≤ w" for x
using False ‹dm ≥ 0› that by force
have "dist (q k um) (q (k+1) um) = 2^k * dm"
unfolding q_def apply (subst geodesic_segment_param(7)[where ?y = "f um"])
using x(3)[of um] ‹x ∈ {um..ym}› aux by (auto simp add: metric_space_class.dist_commute, simp add: algebra_simps)
have "dist (q k w) (q (k+1) w) = 2^k * dm"
unfolding q_def apply (subst geodesic_segment_param(7)[where ?y = "f w"])
using x(3)[of w] ‹w ∈ {um..x}› ‹x ∈ {um..ym}› aux by (auto simp add: metric_space_class.dist_commute, simp add: algebra_simps)
have i: "q k um ∈ proj_set (q (k+1) um) (V k)"
unfolding q_def V_def apply (rule proj_set_thickening'[of _ "f um"])
using p x(3)[of um] ‹x ∈ {um..ym}› aux by (auto simp add: algebra_simps metric_space_class.dist_commute)
have j: "q k w ∈ proj_set (q (k+1) w) (V k)"
unfolding q_def V_def apply (rule proj_set_thickening'[of _ "f w"])
using p x(3)[of w] ‹x ∈ {um..ym}› ‹w ∈ {um..x}› aux by (auto simp add: algebra_simps metric_space_class.dist_commute)
have "5 * delta + 2 * QC k ≤ dist (q k um) (q k w)" using w(2) by simp
also have "... ≤ max (5 * deltaG(TYPE('a)) + 2 * QC k)
(dist (q (k + 1) um) (q (k + 1) w) - dist (q k um) (q (k + 1) um) - dist (q k w) (q (k + 1) w) + 10 * deltaG(TYPE('a)) + 4 * QC k)"
by (rule proj_along_quasiconvex_contraction[OF ‹quasiconvex (QC k) (V k)› i j])
finally have "5 * delta + 2 * QC k ≤ dist (q (k + 1) um) (q (k + 1) w) - dist (q k um) (q (k + 1) um) - dist (q k w) (q (k + 1) w) + 10 * deltaG(TYPE('a)) + 4 * QC k"
using ‹deltaG(TYPE('a)) < delta› by auto
then have "0 ≤ dist (q (k + 1) um) (q (k + 1) w) + 5 * delta + 2 * QC k - dist (q k um) (q (k + 1) um) - dist (q k w) (q (k + 1) w)"
using ‹deltaG(TYPE('a)) < delta› by auto
also have "... = dist (q (k + 1) um) (q (k + 1) w) + 5 * delta + 2 * QC k - 2^(k+1) * dm"
by (simp only: ‹dist (q k w) (q (k+1) w) = 2^k * dm› ‹dist (q k um) (q (k+1) um) = 2^k * dm›, auto)
finally have *: "2^(k+1) * dm - 5 * delta - 2 * QC k ≤ dist (q (k+1) um) (q (k+1) w)"
using ‹deltaG(TYPE('a)) < delta› by auto
have "L - 4 * delta + 7 * QC (k+1) ≤ 2 * dm - 5 * delta - 2 * QC k"
unfolding QC_def L_def using ‹delta > 0› Laux I ‹C ≥ 0› by auto
also have "... ≤ 2^(k+1) * dm - 5 * delta - 2 * QC k"
using aux by (auto simp add: algebra_simps)
finally show "L - 4 * delta + 7 * QC (Suc k) ≤ dist (q (Suc k) um) (q (Suc k) w)"
using * by auto
qed
then show ?thesis
by simp
qed
qed
qed
text ‹This is the end of the main induction over $k$. To conclude, choose $k$ large enough
so that the second alternative in this induction is impossible. It follows that the first
alternative holds, i.e., the desired inequality is true.›
have "dm > 0" using I ‹delta > 0› ‹C ≥ 0› Laux by auto
have "∃k. 2^k > dist (f um) (p um)/dm + 1"
by (simp add: real_arch_pow)
then obtain k where "2^k > dist (f um) (p um)/dm + 1"
by blast
then have "dist (f um) (p um) < (2^k - 1) * dm"
using ‹dm > 0› by (auto simp add: divide_simps algebra_simps)
also have "... ≤ (2^(Suc k) - 1) * dm"
by (intro mono_intros, auto)
finally have "¬((2 ^ (k + 1) - 1) * dm ≤ dist (f um) (p um))"
by simp
then show "Gromov_product_at (f z) (f um) (f uM) ≤ lambda⇧2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp (- K * (uM - um)))"
using Ind_k[of k] by auto
text ‹end of the case where $D + 4 * C \leq dm$ and $dM \leq dm$.›
next
case 3
text ‹This is the exact copy of the previous case, except that the roles of the points before
and after $z$ are exchanged. In a perfect world, one would use a lemma subsuming both cases,
but in practice copy-paste seems to work better here as there are two many details to be
changed regarding the direction of inequalities.›
then have I: "D + 4 * C ≤ dM" "dm ≤ dM" by auto
define V where "V = (λk::nat. (⋃g∈H. cball g ((2^k - 1) * dM)))"
define QC where "QC = (λk::nat. if k = 0 then 0 else 8 * delta)"
have "QC k ≥ 0" for k unfolding QC_def using ‹delta > 0› by auto
have Q: "quasiconvex (0 + 8 * deltaG(TYPE('a))) (V k)" for k
unfolding V_def apply (rule quasiconvex_thickening) using geodesic_segmentI[OF H]
by (auto simp add: quasiconvex_of_geodesic)
have "quasiconvex (QC k) (V k)" for k
apply (cases "k = 0")
apply (simp add: V_def QC_def quasiconvex_of_geodesic geodesic_segmentI[OF H])
apply (rule quasiconvex_mono[OF _ Q[of k]]) using ‹deltaG(TYPE('a)) < delta› QC_def by auto
define q::"nat ⇒ real ⇒ 'a" where "q = (λk x. geodesic_segment_param {p x--f x} (p x) ((2^k - 1) * dM))"
have Ind_k: "(Gromov_product_at (f z) (f um) (f uM) ≤ lambda^2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (uM - um))))
∨ (∃x ∈ {yM..uM}. (∀y ∈ {x..uM}. dist (f y) (p y) ≥ (2^(k+1)-1) * dM) ∧ dist (q k uM) (q k x) ≥ L - 4 * delta + 7 * QC k)" for k
proof (induction k)
case 0
have *: "∃x∈ {yM..uM}. (∀y ∈ {x..uM}. dist (f y) (p y) ≥ (2^(0+1)-1) * dM) ∧ dist (q 0 uM) (q 0 x) ≥ L - 4 * delta + 7 * QC 0"
proof (rule bexI[of _ yM], auto simp add: V_def q_def QC_def)
show "yM ≤ uM" using ‹yM ∈ {z..uM}› by auto
show "L -4 * delta ≤ dist (p uM) (p yM)"
using yM(2) apply auto using metric_space_class.zero_le_dist[of pi_z "p uM"] by linarith
show "⋀y. y ≤ uM ⟹ yM ≤ y ⟹ dM ≤ dist (f y) (p y)"
using dM_def closestM proj_setD(2)[OF p] by auto
qed
then show ?case
by blast
next
case Suck: (Suc k)
show ?case
proof (cases "Gromov_product_at (f z) (f um) (f uM) ≤ lambda⇧2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp (- K * (uM - um)))")
case True
then show ?thesis by simp
next
case False
then obtain x where x: "x ∈ {yM..uM}" "dist (q k uM) (q k x) ≥ L - 4 * delta + 7 * QC k"
"⋀w. w ∈ {x..uM} ⟹ dist (f w) (p w) ≥ (2^(k+1)-1) * dM"
using Suck.IH by auto
have aux: "(2 ^ k - 1) * dM ≤ (2*2^k-1) * dM" "0 ≤ 2 * 2 ^ k - (1::real)" "dM ≤ dM * 2 ^ k"
apply (auto simp add: algebra_simps)
apply (metis power.simps(2) two_realpow_ge_one)
using ‹0 ≤ dM› less_eq_real_def by fastforce
have "L + C = (L/D) * (D + (D/L) * C)"
using ‹L > 0› ‹D > 0› by (simp add: algebra_simps divide_simps)
also have "... ≤ (L/D) * (D + 4 * C)"
apply (intro mono_intros)
using ‹L > 0› ‹D > 0› ‹C ≥ 0› ‹D ≤ 4 * L› by (auto simp add: algebra_simps divide_simps)
also have "... ≤ (L/D) * dM"
apply (intro mono_intros) using I ‹L > 0› ‹D > 0› by auto
finally have "L + C ≤ (L/D) * dM"
by simp
moreover have "2 * delta ≤ (2 * delta)/D * dM"
using I ‹C ≥ 0› ‹delta > 0› ‹D > 0› by (auto simp add: algebra_simps divide_simps)
ultimately have aux2: "L + C + 2 * delta ≤ ((L + 2 * delta)/D) * dM"
by (auto simp add: algebra_simps divide_simps)
have aux3: "(1-alpha) * D + alpha * 2^k * dM ≤ dM * 2^k - C/2 - QC k"
proof (cases "k = 0")
case True
show ?thesis
using I ‹C ≥ 0› unfolding True QC_def alpha_def by auto
next
case False
have "C/2 + QC k + (1-alpha) * D ≤ 2 * (1-alpha) * dM"
using I ‹C ≥ 0› unfolding QC_def alpha_def using False Laux by auto
also have "... ≤ 2^k * (1-alpha) * dM"
apply (intro mono_intros) using False alphaaux I ‹D > 0› ‹C ≥ 0› by auto
finally show ?thesis
by (simp add: algebra_simps)
qed
have "∃w ∈ {x..uM}. (dist (q k uM) (q k w) ∈ {(9 * delta + 4 * QC k) - 4 * delta - 2 * QC k .. 9 * delta + 4 * QC k})
∧ (∀v ∈ {w..uM}. dist (q k uM) (q k v) ≤ 9 * delta + 4 * QC k)"
proof (rule quasi_convex_projection_small_gaps'[where ?f = f and ?G = "V k"])
show "continuous_on {x..uM} f"
apply (rule continuous_on_subset[OF ‹continuous_on {a..b} f›])
using ‹uM ∈ {z..b}› ‹z ∈ {a..b}› ‹yM ∈ {z..uM}› ‹x ∈ {yM..uM}› by auto
show "x ≤ uM" using ‹x ∈ {yM..uM}› by auto
show "quasiconvex (QC k) (V k)" by fact
show "deltaG TYPE('a) < delta" by fact
show "9 * delta + 4 * QC k ∈ {4 * delta + 2 * QC k..dist (q k x) (q k uM)}"
using x(2) ‹delta > 0› ‹QC k ≥ 0› Laux by (auto simp add: metric_space_class.dist_commute)
show "q k w ∈ proj_set (f w) (V k)" if "w ∈ {x..uM}" for w
unfolding V_def q_def apply (rule proj_set_thickening)
using aux p x(3)[OF that] by (auto simp add: metric_space_class.dist_commute)
qed
then obtain w where w: "w ∈ {x..uM}"
"dist (q k uM) (q k w) ∈ {(9 * delta + 4 * QC k) - 4 * delta - 2 * QC k .. 9 * delta + 4 * QC k}"
"⋀v. v ∈ {w..uM} ⟹ dist (q k uM) (q k v) ≤ 9 * delta + 4 * QC k"
by auto
show ?thesis
proof (cases "∃v ∈ {w..uM}. dist (f v) (p v) ≤ (2^(k+2)-1) * dM")
case True
then obtain v where v: "v ∈ {w..uM}" "dist (f v) (p v) ≤ (2^(k+2)-1) * dM"
by auto
have aux4: "dM * 2 ^ k ≤ infdist (f r) (V k)" if "r ∈ {x..v}" for r
proof -
have *: "q k r ∈ proj_set (f r) (V k)"
unfolding q_def V_def apply (rule proj_set_thickening)
using aux p[of r] x(3)[of r] that ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› by (auto simp add: metric_space_class.dist_commute)
have "infdist (f r) (V k) = dist (geodesic_segment_param {p r--f r} (p r) (dist (p r) (f r))) (geodesic_segment_param {p r--f r} (p r) ((2 ^ k - 1) * dM))"
using proj_setD(2)[OF *] unfolding q_def by auto
also have "... = abs(dist (p r) (f r) - (2 ^ k - 1) * dM)"
apply (rule geodesic_segment_param(7)[where ?y = "f r"])
using x(3)[of r] ‹r ∈ {x..v}› ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› aux by (auto simp add: metric_space_class.dist_commute)
also have "... = dist (f r) (p r) - (2 ^ k - 1) * dM"
using x(3)[of r] ‹r ∈ {x..v}› ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› aux by (auto simp add: metric_space_class.dist_commute)
finally have "dist (f r) (p r) = infdist (f r) (V k) + (2 ^ k - 1) * dM" by simp
moreover have "(2^(k+1) - 1) * dM ≤ dist (f r) (p r)"
apply (rule x(3)) using ‹r ∈ {x..v}› ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› by auto
ultimately have "(2^(k+1) - 1) * dM ≤ infdist (f r) (V k) + (2 ^ k - 1) * dM"
by simp
then show ?thesis by (auto simp add: algebra_simps)
qed
have "infdist (f v) H ≤ (2^(k+2)-1) * dM"
using v proj_setD(2)[OF p[of v]] by auto
have "dist closestm v ≤ lambda * (infdist (f closestm) H + (L + C + 2 * delta) + infdist (f v) H)"
apply (rule D)
using ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› ‹x ∈ {yM..uM}› ‹yM ∈ {z..uM}› ‹uM ∈ {z..b}› ‹z ∈ {a..b}› ‹closestm ∈ {um..ym}› ‹ym ∈ {um..z}› ‹um ∈ {a..z}› by auto
also have "... ≤ lambda * (dm + 1 * (L + C + 2 * delta) + (2^(k+2)-1) * dM)"
apply (intro mono_intros ‹infdist (f v) H ≤ (2^(k+2)-1) * dM›)
using dm_def ‹lambda ≥ 1› ‹L > 0› ‹C ≥ 0› ‹delta > 0› by (auto simp add: metric_space_class.dist_commute)
also have "... ≤ lambda * (dM + 2^k * (((L + 2 * delta)/D) * dM) + (2^(k+2)-1) * dM)"
apply (intro mono_intros) using I ‹lambda ≥ 1› ‹C ≥ 0› ‹delta > 0› ‹L > 0› aux2 by auto
also have "... = lambda * 2^k * (4 + (L + 2 * delta)/D) * dM"
by (simp add: algebra_simps)
finally have *: "dist closestm v / (lambda * (4 + (L + 2 * delta)/D)) ≤ 2^k * dM"
using ‹lambda ≥ 1› ‹L > 0› ‹D > 0› ‹delta > 0› by (simp add: divide_simps, simp add: algebra_simps)
have "exp(- (alpha * (2^k * dM) * ln 2 / (5 * delta))) ≤ exp(-(alpha * (dist closestm v / (lambda * (4 + (L + 2 * delta)/D))) * ln 2 / (5 * delta)))"
apply (intro mono_intros *) using alphaaux ‹delta > 0› by auto
also have "... = exp(-K * dist closestm v)"
unfolding K_def by (simp add: divide_simps)
also have "... = exp(-K * (v - closestm))"
unfolding dist_real_def using ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› ‹x ∈ {yM..uM}› ‹yM ∈ {z..uM}› ‹ym ∈ {um..z}› ‹closestm ∈ {um..ym}› ‹K > 0› by auto
finally have "exp(- (alpha * (2^k * dM) * ln 2 / (5 * delta))) ≤ exp(-K * (v - closestm))"
by simp
then have "K * (v - x) * exp(- (alpha * (2^k * dM) * ln 2 / (5 * delta))) ≤ K * (v - x) * exp(-K * (v - closestm))"
apply (rule mult_left_mono)
using ‹delta > 0› ‹lambda ≥ 1› ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› ‹K > 0› by auto
also have "... = ((1 + K * (v - x)) - 1) * exp(- K * (v - closestm))"
by (auto simp add: algebra_simps)
also have "... ≤ (exp (K * (v - x)) - 1) * exp(-K * (v - closestm))"
by (intro mono_intros, auto)
also have "... = exp(-K * (x - closestm)) - exp(-K * (v - closestm))"
by (simp add: algebra_simps mult_exp_exp)
also have "... ≤ exp(-K * (x - closestm)) - exp(-K * (uM - um))"
using ‹K > 0› ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› ‹x ∈ {yM..uM}› ‹yM ∈ {z..uM}› ‹ym ∈ {um..z}› ‹closestm ∈ {um..ym}› by auto
finally have B: "(v - x) * exp(- alpha * 2^k * dM * ln 2 / (5 * delta)) ≤
(exp(-K * (x - closestm)) - exp(-K * (uM - um)))/K"
using ‹K > 0› by (auto simp add: divide_simps algebra_simps)
text ‹The projections of $f(v)$ and $f(x)$ on the cylinder $V_k$ are well separated,
by construction. This implies that $v$ and $x$ themselves are well separated.›
have "L - 4 * delta + 7 * QC k ≤ dist (q k uM) (q k x)"
using x by simp
also have "... ≤ dist (q k uM) (q k v) + dist (q k v) (q k x)"
by (intro mono_intros)
also have "... ≤ (9 * delta + 4 * QC k) + dist (q k v) (q k x)"
using w(3)[of v] ‹v ∈ {w..uM}› by auto
finally have "L - 13 * delta + 3 * QC k ≤ dist (q k x) (q k v)"
by (simp add: metric_space_class.dist_commute)
also have "... ≤ 3 * QC k + max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (v - x) * exp(-(dM * 2^k - C/2 - QC k) * ln 2 / (5 * delta)))"
proof (cases "k = 0")
case True
have "dist (q k x) (q k v) ≤ max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (v - x) * exp(-(dM * 2^k - C/2) * ln 2 / (5 * delta)))"
proof (rule geodesic_projection_exp_contracting[where ?G = "V k" and ?f = f])
show "geodesic_segment (V k)" unfolding V_def True using geodesic_segmentI[OF H] by auto
show "x ≤ v" using ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› by auto
show "q k v ∈ proj_set (f v) (V k)"
unfolding q_def V_def apply (rule proj_set_thickening)
using aux p[of v] x(3)[of v] ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› by (auto simp add: metric_space_class.dist_commute)
show "q k x ∈ proj_set (f x) (V k)"
unfolding q_def V_def apply (rule proj_set_thickening)
using aux p[of x] x(3)[of x] ‹w ∈ {x..uM}› by (auto simp add: metric_space_class.dist_commute)
show "15/2 * delta + C/2 ≤ dM * 2^k"
using I ‹delta > 0› ‹C ≥ 0› Laux unfolding QC_def True by auto
show "deltaG TYPE('a) < delta" by fact
show "⋀t. t ∈ {x..v} ⟹ dM * 2 ^ k ≤ infdist (f t) (V k)"
using aux4 by auto
show "0 ≤ C" "0 ≤ lambda" using ‹C ≥ 0› ‹lambda ≥ 1› by auto
show "dist (f x1) (f x2) ≤ lambda * dist x1 x2 + C" if "x1 ∈ {x..v}" "x2 ∈ {x..v}" for x1 x2
using quasi_isometry_onD(1)[OF assms(2)] that ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› ‹x ∈ {yM..uM}› ‹yM ∈ {z..uM}› ‹uM ∈ {z..b}› ‹z ∈ {a..b}› by auto
qed
then show ?thesis unfolding QC_def True by auto
next
case False
have "dist (q k x) (q k v) ≤ 2 * QC k + 8 * delta + max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (v - x) * exp(-(dM * 2^k - QC k - C/2) * ln 2 / (5 * delta)))"
proof (rule quasiconvex_projection_exp_contracting[where ?G = "V k" and ?f = f])
show "quasiconvex (QC k) (V k)" by fact
show "x ≤ v" using ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› by auto
show "q k v ∈ proj_set (f v) (V k)"
unfolding q_def V_def apply (rule proj_set_thickening)
using aux p[of v] x(3)[of v] ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› by (auto simp add: metric_space_class.dist_commute)
show "q k x ∈ proj_set (f x) (V k)"
unfolding q_def V_def apply (rule proj_set_thickening)
using aux p[of x] x(3)[of x] ‹w ∈ {x..uM}› by (auto simp add: metric_space_class.dist_commute)
show "15/2 * delta + QC k + C/2 ≤ dM * 2^k"
apply (rule order_trans[of _ dM])
using I ‹delta > 0› ‹C ≥ 0› Laux unfolding QC_def by auto
show "deltaG TYPE('a) < delta" by fact
show "⋀t. t ∈ {x..v} ⟹ dM * 2 ^ k ≤ infdist (f t) (V k)"
using aux4 by auto
show "0 ≤ C" "0 ≤ lambda" using ‹C ≥ 0› ‹lambda ≥ 1› by auto
show "dist (f x1) (f x2) ≤ lambda * dist x1 x2 + C" if "x1 ∈ {x..v}" "x2 ∈ {x..v}" for x1 x2
using quasi_isometry_onD(1)[OF assms(2)] that ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› ‹x ∈ {yM..uM}› ‹yM ∈ {z..uM}› ‹uM ∈ {z..b}› ‹z ∈ {a..b}› by auto
qed
then show ?thesis unfolding QC_def using False by (auto simp add: algebra_simps)
qed
finally have "L - 13 * delta ≤ max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (v - x) * exp(-(dM * 2^k - C/2 - QC k) * ln 2 / (5 * delta)))"
by auto
then have "L - 13 * delta ≤ (4 * exp(1/2 * ln 2)) * lambda * (v - x) * exp(-(dM * 2^k - C/2 - QC k) * ln 2 / (5 * delta))"
using ‹delta > deltaG(TYPE('a))› Laux by auto
also have "... ≤ (4 * exp(1/2 * ln 2)) * lambda * (v - x) * exp(-((1-alpha) * D + alpha * 2^k * dM) * ln 2 / (5 * delta))"
apply (intro mono_intros) using aux3 ‹delta > 0› ‹lambda ≥ 1› ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› by auto
also have "... = (4 * exp(1/2 * ln 2)) * lambda * (v - x) * (exp(-(1-alpha) * D * ln 2 / (5 * delta)) * exp(-alpha * 2^k * dM * ln 2 / (5 * delta)))"
unfolding mult_exp_exp by (auto simp add: algebra_simps divide_simps)
finally have A: "L - 13 * delta ≤ (4 * exp(1/2 * ln 2)) * lambda * exp(-(1-alpha) * D * ln 2 / (5 * delta)) * ((v - x) * exp(-alpha * 2^k * dM * ln 2 / (5 * delta)))"
by (simp add: algebra_simps)
also have "... ≤ (4 * exp(1/2 * ln 2)) * lambda * exp 0 * ((v - x) * exp 0)"
apply (intro mono_intros) using ‹delta > 0› ‹lambda ≥ 1› ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› alphaaux ‹D > 0› ‹C ≥ 0› I
by (auto simp add: divide_simps mult_nonpos_nonneg)
also have "... = (4 * exp(1/2 * ln 2)) * lambda * (v - x)"
by simp
also have "... ≤ 20 * lambda * (v - x)"
apply (intro mono_intros, approximation 10)
using ‹delta > 0› ‹lambda ≥ 1› ‹v ∈ {w..uM}› ‹w ∈ {x..uM}› by auto
finally have "v - x ≥ (1/4) * delta / lambda"
using ‹lambda ≥ 1› L_def ‹delta > 0› by (simp add: divide_simps algebra_simps)
then have "x - closestm + (1/4) * delta / lambda ≤ v - closestm"
by simp
also have "... ≤ uM - um"
using ‹closestm ∈ {um..ym}› ‹v ∈ {w..uM}› by auto
also have "... ≤ Suc n * (1/4) * delta / lambda" by fact
finally have "x - closestm ≤ n * (1/4) * delta / lambda"
unfolding Suc_eq_plus1 by (auto simp add: algebra_simps add_divide_distrib)
have "L + 4 * delta = ((L + 4 * delta)/(L - 13 * delta)) * (L - 13 * delta)"
using Laux ‹delta > 0› by (simp add: algebra_simps divide_simps)
also have "... ≤ ((L + 4 * delta)/(L - 13 * delta)) * ((4 * exp(1/2 * ln 2)) * lambda * exp (- (1 - alpha) * D * ln 2 / (5 * delta)) * ((v - x) * exp (- alpha * 2 ^ k * dM * ln 2 / (5 * delta))))"
apply (rule mult_left_mono) using A Laux ‹delta > 0› by (auto simp add: divide_simps)
also have "... ≤ ((L + 4 * delta)/(L - 13 * delta)) * ((4 * exp(1/2 * ln 2)) * lambda * exp (- (1 - alpha) * D * ln 2 / (5 * delta)) * ((exp(-K * (x - closestm)) - exp(-K * (uM - um)))/K))"
apply (intro mono_intros B) using Laux ‹delta > 0› ‹lambda ≥ 1› by (auto simp add: divide_simps)
finally have C: "L + 4 * delta ≤ Kmult * (exp(-K * (x - closestm)) - exp(-K * (uM - um)))"
unfolding Kmult_def by argo
have "Gromov_product_at (f z) (f um) (f uM) ≤ Gromov_product_at (f z) (f closestm) (f x) + (L + 4 * delta)"
apply (rule Rec) using ‹closestm ∈ {um..ym}› ‹x ∈ {yM..uM}› ‹yM ∈ {z..uM}› by auto
also have "... ≤ (lambda^2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (x - closestm)))) + (Kmult * (exp(-K * (x - closestm)) - exp(-K * (uM-um))))"
apply (intro mono_intros C Suc.IH)
using ‹x ∈ {yM..uM}› ‹yM ∈ {z..uM}› ‹um ∈ {a..z}› ‹closestm ∈ {um..ym}› ‹ym ∈ {um..z}› ‹uM ∈ {z..b}› ‹x - closestm ≤ n * (1/4) * delta / lambda› by auto
also have "... = (lambda^2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (uM - um))))"
unfolding K_def by (simp add: algebra_simps)
finally show ?thesis by auto
next
case False
have "∃w∈{yM..uM}. (∀r∈{w..uM}. (2 ^ (Suc k + 1) - 1) * dM ≤ dist (f r) (p r)) ∧ L - 4 * delta + 7 * QC (Suc k) ≤ dist (q (Suc k) uM) (q (Suc k) w)"
proof (rule bexI[of _ w], auto)
show "w ≤ uM" "yM ≤ w" using ‹w ∈ {x..uM}› ‹x ∈ {yM..uM}› by auto
show "(4 * 2 ^ k - 1) * dM ≤ dist (f x) (p x)" if "x ≤ uM" "w ≤ x" for x
using False ‹dM ≥ 0› that by force
have "dist (q k uM) (q (k+1) uM) = 2^k * dM"
unfolding q_def apply (subst geodesic_segment_param(7)[where ?y = "f uM"])
using x(3)[of uM] ‹x ∈ {yM..uM}› aux by (auto simp add: metric_space_class.dist_commute, simp add: algebra_simps)
have "dist (q k w) (q (k+1) w) = 2^k * dM"
unfolding q_def apply (subst geodesic_segment_param(7)[where ?y = "f w"])
using x(3)[of w] ‹w ∈ {x..uM}› ‹x ∈ {yM..uM}› aux by (auto simp add: metric_space_class.dist_commute, simp add: algebra_simps)
have i: "q k uM ∈ proj_set (q (k+1) uM) (V k)"
unfolding q_def V_def apply (rule proj_set_thickening'[of _ "f uM"])
using p x(3)[of uM] ‹x ∈ {yM..uM}› aux by (auto simp add: algebra_simps metric_space_class.dist_commute)
have j: "q k w ∈ proj_set (q (k+1) w) (V k)"
unfolding q_def V_def apply (rule proj_set_thickening'[of _ "f w"])
using p x(3)[of w] ‹x ∈ {yM..uM}› ‹w ∈ {x..uM}› aux by (auto simp add: algebra_simps metric_space_class.dist_commute)
have "5 * delta + 2 * QC k ≤ dist (q k uM) (q k w)" using w(2) by simp
also have "... ≤ max (5 * deltaG(TYPE('a)) + 2 * QC k)
(dist (q (k + 1) uM) (q (k + 1) w) - dist (q k uM) (q (k + 1) uM) - dist (q k w) (q (k + 1) w) + 10 * deltaG(TYPE('a)) + 4 * QC k)"
by (rule proj_along_quasiconvex_contraction[OF ‹quasiconvex (QC k) (V k)› i j])
finally have "5 * delta + 2 * QC k ≤ dist (q (k + 1) uM) (q (k + 1) w) - dist (q k uM) (q (k + 1) uM) - dist (q k w) (q (k + 1) w) + 10 * deltaG(TYPE('a)) + 4 * QC k"
using ‹deltaG(TYPE('a)) < delta› by auto
then have "0 ≤ dist (q (k + 1) uM) (q (k + 1) w) + 5 * delta + 2 * QC k - dist (q k uM) (q (k + 1) uM) - dist (q k w) (q (k + 1) w)"
using ‹deltaG(TYPE('a)) < delta› by auto
also have "... = dist (q (k + 1) uM) (q (k + 1) w) + 5 * delta + 2 * QC k - 2^(k+1) * dM"
by (simp only: ‹dist (q k w) (q (k+1) w) = 2^k * dM› ‹dist (q k uM) (q (k+1) uM) = 2^k * dM›, auto)
finally have *: "2^(k+1) * dM - 5 * delta - 2 * QC k ≤ dist (q (k+1) uM) (q (k+1) w)"
using ‹deltaG(TYPE('a)) < delta› by auto
have "L - 4 * delta + 7 * QC (k+1) ≤ 2 * dM - 5 * delta - 2 * QC k"
unfolding QC_def L_def using ‹delta > 0› Laux I ‹C ≥ 0› by auto
also have "... ≤ 2^(k+1) * dM - 5 * delta - 2 * QC k"
using aux by (auto simp add: algebra_simps)
finally show "L - 4 * delta + 7 * QC (Suc k) ≤ dist (q (Suc k) uM) (q (Suc k) w)"
using * by auto
qed
then show ?thesis
by simp
qed
qed
qed
have "dM > 0" using I ‹delta > 0› ‹C ≥ 0› Laux by auto
have "∃k. 2^k > dist (f uM) (p uM)/dM + 1"
by (simp add: real_arch_pow)
then obtain k where "2^k > dist (f uM) (p uM)/dM + 1"
by blast
then have "dist (f uM) (p uM) < (2^k - 1) * dM"
using ‹dM > 0› by (auto simp add: divide_simps algebra_simps)
also have "... ≤ (2^(Suc k) - 1) * dM"
by (intro mono_intros, auto)
finally have "¬((2 ^ (k + 1) - 1) * dM ≤ dist (f uM) (p uM))"
by simp
then show "Gromov_product_at (f z) (f um) (f uM) ≤ lambda⇧2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp (- K * (uM - um)))"
using Ind_k[of k] by auto
qed
qed
qed
text ‹The main induction is over. To conclude, one should apply its result to the original
geodesic segment joining the points $f(a)$ and $f(b)$.›
obtain n::nat where "(b - a)/((1/4) * delta / lambda) ≤ n"
using real_arch_simple by blast
then have "b - a ≤ n * (1/4) * delta / lambda"
using ‹delta > 0› ‹lambda ≥ 1› by (auto simp add: divide_simps)
have "infdist (f z) G ≤ Gromov_product_at (f z) (f a) (f b) + 2 * deltaG(TYPE('a))"
apply (intro mono_intros) using assms by auto
also have "... ≤ (lambda^2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(-K * (b - a)))) + 2 * delta"
apply (intro mono_intros Main[OF _ _ ‹b - a ≤ n * (1/4) * delta / lambda›]) using assms by auto
also have "... = lambda^2 * (D + 3/2 * L + delta + 11/2 * C) + Kmult * (1 - exp(-K * (b - a)))"
by simp
also have "... ≤ lambda^2 * (D + 3/2 * L + delta + 11/2 * C) + Kmult * (1 - 0)"
apply (intro mono_intros) using ‹Kmult > 0› by auto
also have "... = lambda^2 * (11/2 * C + (3200*exp(-459/50*ln 2)/ln 2 + 83) * delta)"
unfolding Kmult_def K_def L_def alpha_def D_def using ‹delta > 0› ‹lambda ≥ 1› by (simp add: algebra_simps divide_simps power2_eq_square mult_exp_exp)
also have "... ≤ lambda^2 * (11/2 * C + 91 * delta)"
apply (intro mono_intros, simp add: divide_simps, approximation 14)
using ‹delta > 0› by auto
finally show ?thesis by (simp add: algebra_simps)
qed
text ‹Still assuming that our quasi-isometry is Lipschitz, we will improve slightly on the previous
result, first going down to the hyperbolicity constant of the space, and also showing that,
conversely, the geodesic is contained in a neighborhood of the quasi-geodesic. The argument for this
last point goes as follows. Consider a point $x$ on the geodesic. Define two sets to
be the $D$-thickenings of $[a,x]$ and $[x,b]$ respectively, where $D$ is such that any point on the
quasi-geodesic is within distance $D$ of the geodesic (as given by the previous theorem). The union
of these two sets covers the quasi-geodesic, and they are both closed and nonempty. By connectedness,
there is a point $z$ in their intersection, $D$-close both to a point $x^-$ before $x$ and to a point
$x^+$ after $x$. Then $x$ belongs to a geodesic between $x^-$ and $x^+$, which is contained in a
$4\delta$-neighborhood of geodesics from $x^+$ to $z$ and from $x^-$ to $z$ by hyperbolicity. It
follows that $x$ is at distance at most $D + 4\delta$ of $z$, concluding the proof.›
lemma (in Gromov_hyperbolic_space_geodesic) Morse_Gromov_theorem_aux2:
fixes f::"real ⇒ 'a"
assumes "continuous_on {a..b} f"
"lambda C-quasi_isometry_on {a..b} f"
"geodesic_segment_between G (f a) (f b)"
shows "hausdorff_distance (f`{a..b}) G ≤ lambda^2 * (11/2 * C + 92 * deltaG(TYPE('a)))"
proof (cases "a ≤ b")
case True
have "lambda ≥ 1" "C ≥ 0" using quasi_isometry_onD[OF assms(2)] by auto
have *: "infdist (f z) G ≤ lambda^2 * (11/2 * C + 91 * delta)" if "z ∈ {a..b}" "delta > deltaG(TYPE('a))" for z delta
by (rule Morse_Gromov_theorem_aux1[OF assms(1) assms(2) True assms(3) that])
define D where "D = lambda^2 * (11/2 * C + 91 * deltaG(TYPE('a)))"
have "D ≥ 0" unfolding D_def using ‹C ≥ 0› by auto
have I: "infdist (f z) G ≤ D" if "z ∈ {a..b}" for z
proof -
have "(infdist (f z) G/ lambda^2 - 11/2 * C)/91 ≤ delta" if "delta > deltaG(TYPE('a))" for delta
using *[OF ‹z ∈ {a..b}› that] ‹lambda ≥ 1› by (auto simp add: divide_simps algebra_simps)
then have "(infdist (f z) G/ lambda^2 - 11/2 * C)/91 ≤ deltaG(TYPE('a))"
using dense_ge by blast
then show ?thesis unfolding D_def using ‹lambda ≥ 1› by (auto simp add: divide_simps algebra_simps)
qed
show ?thesis
proof (rule hausdorff_distanceI)
show "0 ≤ lambda⇧2 * (11/2 * C + 92 * deltaG TYPE('a))" using ‹C ≥ 0› by auto
fix x assume "x ∈ f`{a..b}"
then obtain z where z: "x = f z" "z ∈ {a..b}" by blast
show "infdist x G ≤ lambda⇧2 * (11/2 * C + 92 * deltaG TYPE('a))"
unfolding z(1) by (rule order_trans[OF I[OF ‹z ∈ {a..b}›]], auto simp add: algebra_simps D_def)
next
fix x assume "x ∈ G"
have "infdist x (f`{a..b}) ≤ D + 1 * deltaG TYPE('a)"
proof -
define p where "p = geodesic_segment_param G (f a)"
then have p: "p 0 = f a" "p (dist (f a) (f b)) = f b"
unfolding p_def using assms(3) by auto
obtain t where t: "x = p t" "t ∈ {0..dist (f a) (f b)}"
unfolding p_def using ‹x ∈ G› ‹geodesic_segment_between G (f a) (f b)› by (metis geodesic_segment_param(5) imageE)
define Km where "Km = (⋃z ∈ p`{0..t}. cball z D)"
define KM where "KM = (⋃z ∈ p`{t..dist (f a) (f b)}. cball z D)"
have "f`{a..b} ⊆ Km ∪ KM"
proof
fix x assume x: "x ∈ f`{a..b}"
have "∃z ∈ G. infdist x G = dist x z"
apply (rule infdist_proper_attained)
using geodesic_segment_topology[OF geodesic_segmentI[OF assms(3)]] by auto
then obtain z where z: "z ∈ G" "infdist x G = dist x z"
by auto
obtain tz where tz: "z = p tz" "tz ∈ {0..dist (f a) (f b)}"
unfolding p_def using ‹z ∈ G› ‹geodesic_segment_between G (f a) (f b)› by (metis geodesic_segment_param(5) imageE)
have "infdist x G ≤ D"
using I ‹x ∈ f`{a..b}› by auto
then have "dist z x ≤ D"
using z(2) by (simp add: metric_space_class.dist_commute)
then show "x ∈ Km ∪ KM"
unfolding Km_def KM_def using tz by force
qed
then have *: "f`{a..b} = (Km ∩ f`{a..b}) ∪ (KM ∩ f`{a..b})" by auto
have "(Km ∩ f`{a..b}) ∩ (KM ∩ f`{a..b}) ≠ {}"
proof (rule connected_as_closed_union[OF _ *])
have "closed (f ` {a..b})"
apply (intro compact_imp_closed compact_continuous_image) using assms(1) by auto
have "closed Km"
unfolding Km_def apply (intro compact_has_closed_thickening compact_continuous_image)
apply (rule continuous_on_subset[of "{0..dist (f a) (f b)}" p])
unfolding p_def using assms(3) ‹t ∈ {0..dist (f a) (f b)}› by (auto simp add: isometry_on_continuous)
then show "closed (Km ∩ f`{a..b})"
by (rule topological_space_class.closed_Int) fact
have "closed KM"
unfolding KM_def apply (intro compact_has_closed_thickening compact_continuous_image)
apply (rule continuous_on_subset[of "{0..dist (f a) (f b)}" p])
unfolding p_def using assms(3) ‹t ∈ {0..dist (f a) (f b)}› by (auto simp add: isometry_on_continuous)
then show "closed (KM ∩ f`{a..b})"
by (rule topological_space_class.closed_Int) fact
show "connected (f`{a..b})"
apply (rule connected_continuous_image) using assms(1) by auto
have "f a ∈ Km ∩ f`{a..b}" using True apply auto
unfolding Km_def apply auto apply (rule bexI[of _ 0])
unfolding p using ‹D ≥ 0› t(2) by auto
then show "Km ∩ f`{a..b} ≠ {}" by auto
have "f b ∈ KM ∩ f`{a..b}" apply auto
unfolding KM_def apply auto apply (rule bexI[of _ "dist (f a) (f b)"])
unfolding p using ‹D ≥ 0› t(2) True by auto
then show "KM ∩ f`{a..b} ≠ {}" by auto
qed
then obtain y where y: "y ∈ f`{a..b}" "y ∈ Km" "y ∈ KM" by auto
obtain tm where tm: "tm ∈ {0..t}" "dist (p tm) y ≤ D"
using y(2) unfolding Km_def by auto
obtain tM where tM: "tM ∈ {t..dist (f a) (f b)}" "dist (p tM) y ≤ D"
using y(3) unfolding KM_def by auto
define H where "H = p`{tm..tM}"
have *: "geodesic_segment_between H (p tm) (p tM)"
unfolding H_def p_def apply (rule geodesic_segmentI2)
using assms(3) ‹tm ∈ {0..t}› ‹tM ∈ {t..dist (f a) (f b)}› isometry_on_subset
using assms(3) geodesic_segment_param(4) by (auto) fastforce
have "x ∈ H"
unfolding t(1) H_def using ‹tm ∈ {0..t}› ‹tM ∈ {t..dist (f a) (f b)}› by auto
have "infdist x (f ` {a..b}) ≤ dist x y"
by (rule infdist_le[OF y(1)])
also have "... ≤ max (dist (p tm) y) (dist (p tM) y) + deltaG(TYPE('a))"
by (rule dist_le_max_dist_triangle[OF * ‹x ∈ H›])
finally show ?thesis
using tm(2) tM(2) by auto
qed
also have "... ≤ D + lambda^2 * deltaG TYPE('a)"
apply (intro mono_intros) using ‹lambda ≥ 1› by auto
finally show "infdist x (f ` {a..b}) ≤ lambda⇧2 * (11/2 * C + 92 * deltaG TYPE('a))"
unfolding D_def by (simp add: algebra_simps)
qed
next
case False
then have "f`{a..b} = {}"
by auto
then have "hausdorff_distance (f ` {a..b}) G = 0"
unfolding hausdorff_distance_def by auto
then show ?thesis
using quasi_isometry_onD(4)[OF assms(2)] by auto
qed
text ‹The full statement of the Morse-Gromov Theorem, asserting that a quasi-geodesic is
within controlled distance of a geodesic with the same endpoints. It is given in the formulation
of Shchur~\cite{shchur}, with optimal control in terms of the parameters of the quasi-isometry.
This statement follows readily from the previous one and from the fact that quasi-geodesics can be
approximated by Lipschitz ones.›
theorem (in Gromov_hyperbolic_space_geodesic) Morse_Gromov_theorem:
fixes f::"real ⇒ 'a"
assumes "lambda C-quasi_isometry_on {a..b} f"
"geodesic_segment_between G (f a) (f b)"
shows "hausdorff_distance (f`{a..b}) G ≤ 92 * lambda^2 * (C + deltaG(TYPE('a)))"
proof -
have C: "C ≥ 0" "lambda ≥ 1" using quasi_isometry_onD[OF assms(1)] by auto
consider "dist (f a) (f b) ≥ 2 * C ∧ a ≤ b" | "dist (f a) (f b) ≤ 2 * C ∧ a ≤ b" | "b < a"
by linarith
then show ?thesis
proof (cases)
case 1
have "∃d. continuous_on {a..b} d ∧ d a = f a ∧ d b = f b
∧ (∀x∈{a..b}. dist (f x) (d x) ≤ 4 * C)
∧ lambda (4 * C)-quasi_isometry_on {a..b} d
∧ (2 * lambda)-lipschitz_on {a..b} d
∧ hausdorff_distance (f`{a..b}) (d`{a..b}) ≤ 2 * C"
apply (rule quasi_geodesic_made_lipschitz[OF assms(1)]) using 1 by auto
then obtain d where d: "d a = f a" "d b = f b"
"⋀x. x ∈ {a..b} ⟹ dist (f x) (d x) ≤ 4 * C"
"lambda (4 * C)-quasi_isometry_on {a..b} d"
"(2 * lambda)-lipschitz_on {a..b} d"
"hausdorff_distance (f`{a..b}) (d`{a..b}) ≤ 2 * C"
by auto
have a: "hausdorff_distance (d`{a..b}) G ≤ lambda^2 * ((11/2) * (4 * C) + 92 * deltaG(TYPE('a)))"
apply (rule Morse_Gromov_theorem_aux2) using d assms lipschitz_on_continuous_on by auto
have "hausdorff_distance (f`{a..b}) G ≤
hausdorff_distance (f`{a..b}) (d`{a..b}) + hausdorff_distance (d`{a..b}) G"
apply (rule hausdorff_distance_triangle)
using 1 apply simp
by (rule quasi_isometry_on_bounded[OF d(4)], auto)
also have "... ≤ lambda^2 * ((11/2) * (4 * C) + 92 * deltaG(TYPE('a))) + 1 * 2 * C"
using a d by auto
also have "... ≤ lambda^2 * ((11/2) * (4 * C) + 92 * deltaG(TYPE('a))) + lambda^2 * 2 * C"
apply (intro mono_intros) using ‹lambda ≥ 1› ‹C ≥ 0› by auto
also have "... = lambda^2 * (24 * C + 92 * deltaG(TYPE('a)))"
by (simp add: algebra_simps divide_simps)
also have "... ≤ lambda^2 * (92 * C + 92 * deltaG(TYPE('a)))"
apply (intro mono_intros) using ‹lambda ≥ 1› ‹C ≥ 0› by auto
finally show ?thesis by (auto simp add: algebra_simps)
next
case 2
have "(1/lambda) * dist a b - C ≤ dist (f a) (f b)"
apply (rule quasi_isometry_onD[OF assms(1)]) using 2 by auto
also have "... ≤ 2 * C" using 2 by auto
finally have "dist a b ≤ 3 * lambda * C"
using C by (auto simp add: algebra_simps divide_simps)
then have *: "b - a ≤ 3 * lambda * C" using 2 unfolding dist_real_def by auto
show ?thesis
proof (rule hausdorff_distanceI2)
show "0 ≤ 92 * lambda⇧2 * (C + deltaG TYPE('a))" using C by auto
fix x assume "x ∈ f`{a..b}"
then obtain t where t: "x = f t" "t ∈ {a..b}" by auto
have "dist x (f a) ≤ lambda * dist t a + C"
unfolding t(1) using quasi_isometry_onD(1)[OF assms(1) t(2)] 2 by auto
also have "... ≤ lambda * (b - a) + 1 * 1 * C + 0 * 0 * deltaG(TYPE('a))" using t(2) 2 C unfolding dist_real_def by auto
also have "... ≤ lambda * (3 * lambda * C) + lambda^2 * (92-3) * C + lambda^2 * 92 * deltaG(TYPE('a))"
apply (intro mono_intros *) using C by auto
finally have *: "dist x (f a) ≤ 92 * lambda⇧2 * (C + deltaG TYPE('a))"
by (simp add: algebra_simps power2_eq_square)
show "∃y∈G. dist x y ≤ 92 * lambda⇧2 * (C + deltaG TYPE('a))"
apply (rule bexI[of _ "f a"]) using * 2 assms(2) by auto
next
fix x assume "x ∈ G"
then have "dist x (f a) ≤ dist (f a) (f b)"
by (meson assms geodesic_segment_dist_le geodesic_segment_endpoints(1) local.some_geodesic_is_geodesic_segment(1))
also have "... ≤ 1 * 2 * C + lambda^2 * 0 * deltaG(TYPE('a))"
using 2 by auto
also have "... ≤ lambda^2 * 92 * C + lambda^2 * 92 * deltaG(TYPE('a))"
apply (intro mono_intros) using C by auto
finally have *: "dist x (f a) ≤ 92 * lambda⇧2 * (C + deltaG TYPE('a))"
by (simp add: algebra_simps)
show "∃y∈f`{a..b}. dist x y ≤ 92 * lambda⇧2 * (C + deltaG TYPE('a))"
apply (rule bexI[of _ "f a"]) using * 2 by auto
qed
next
case 3
then have "hausdorff_distance (f ` {a..b}) G = 0"
unfolding hausdorff_distance_def by auto
then show ?thesis
using C by auto
qed
qed
text ‹This theorem implies the same statement for two quasi-geodesics sharing their endpoints.›
theorem (in Gromov_hyperbolic_space_geodesic) Morse_Gromov_theorem2:
fixes c d::"real ⇒ 'a"
assumes "lambda C-quasi_isometry_on {A..B} c"
"lambda C-quasi_isometry_on {A..B} d"
"c A = d A" "c B = d B"
shows "hausdorff_distance (c`{A..B}) (d`{A..B}) ≤ 184 * lambda^2 * (C + deltaG(TYPE('a)))"
proof (cases "A ≤ B")
case False
then have "hausdorff_distance (c`{A..B}) (d`{A..B}) = 0" by auto
then show ?thesis using quasi_isometry_onD[OF assms(1)] delta_nonneg by auto
next
case True
have "hausdorff_distance (c`{A..B}) {c A--c B} ≤ 92 * lambda^2 * (C + deltaG(TYPE('a)))"
by (rule Morse_Gromov_theorem[OF assms(1)], auto)
moreover have "hausdorff_distance {c A--c B} (d`{A..B}) ≤ 92 * lambda^2 * (C + deltaG(TYPE('a)))"
unfolding ‹c A = d A› ‹c B = d B› apply (subst hausdorff_distance_sym)
by (rule Morse_Gromov_theorem[OF assms(2)], auto)
moreover have "hausdorff_distance (c`{A..B}) (d`{A..B}) ≤ hausdorff_distance (c`{A..B}) {c A--c B} + hausdorff_distance {c A--c B} (d`{A..B})"
apply (rule hausdorff_distance_triangle)
using True compact_imp_bounded[OF some_geodesic_compact] by auto
ultimately show ?thesis by auto
qed
text ‹We deduce from the Morse lemma that hyperbolicity is invariant under quasi-isometry.›
text ‹First, we note that the image of a geodesic segment under a quasi-isometry is close to
a geodesic segment in Hausdorff distance, as it is a quasi-geodesic.›
lemma geodesic_quasi_isometric_image:
fixes f::"'a::metric_space ⇒ 'b::Gromov_hyperbolic_space_geodesic"
assumes "lambda C-quasi_isometry_on UNIV f"
"geodesic_segment_between G x y"
shows "hausdorff_distance (f`G) {f x--f y} ≤ 92 * lambda^2 * (C + deltaG(TYPE('b)))"
proof -
define c where "c = f o (geodesic_segment_param G x)"
have *: "(1 * lambda) (0 * lambda + C)-quasi_isometry_on {0..dist x y} c"
unfolding c_def by (rule quasi_isometry_on_compose[where Y = UNIV], auto intro!: isometry_quasi_isometry_on simp add: assms)
have "hausdorff_distance (c`{0..dist x y}) {c 0--c (dist x y)} ≤ 92 * lambda^2 * (C + deltaG(TYPE('b)))"
apply (rule Morse_Gromov_theorem) using * by auto
moreover have "c`{0..dist x y} = f`G"
unfolding c_def image_comp[symmetric] using assms(2) by auto
moreover have "c 0 = f x" "c (dist x y) = f y"
unfolding c_def using assms(2) by auto
ultimately show ?thesis by auto
qed
text ‹We deduce that hyperbolicity is invariant under quasi-isometry. The proof goes as follows:
we want to see that a geodesic triangle is delta-thin, i.e., a point on a side $Gxy$ is close to the
union of the two other sides $Gxz$ and $Gyz$. Pull everything back by the quasi-isometry: we obtain
three quasi-geodesic, each of which is close to the corresponding geodesic segment by the Morse lemma.
As the geodesic triangle is thin, it follows that the quasi-geodesic triangle is also thin, i.e.,
a point on $f^{-1}Gxy$ is close to $f^{-1}Gxz \cup f^{-1}Gyz$ (for some explicit, albeit large,
constant). Then push everything forward by $f$: as it is a quasi-isometry, it will again distort
distances by a bounded amount.›
lemma Gromov_hyperbolic_invariant_under_quasi_isometry_explicit:
fixes f::"'a::geodesic_space ⇒ 'b::Gromov_hyperbolic_space_geodesic"
assumes "lambda C-quasi_isometry f"
shows "Gromov_hyperbolic_subset (752 * lambda^3 * (C + deltaG(TYPE('b)))) (UNIV::('a set))"
proof -
have C: "lambda ≥ 1" "C ≥ 0"
using quasi_isometry_onD[OF assms] by auto
text ‹The Morse lemma gives a control bounded by $K$ below. Following the proof, we deduce
a bound on the thinness of triangles by an ugly constant $L$. We bound it by a more tractable
(albeit still ugly) constant $M$.›
define K where "K = 92 * lambda^2 * (C + deltaG(TYPE('b)))"
have HD: "hausdorff_distance (f`G) {f a--f b} ≤ K" if "geodesic_segment_between G a b" for G a b
unfolding K_def by (rule geodesic_quasi_isometric_image[OF assms that])
define L where "L = lambda * (4 * 1 * deltaG(TYPE('b)) + 1 * 1 * C + 2 * K)"
define M where "M = 188 * lambda^3 * (C + deltaG(TYPE('b)))"
have "L ≤ lambda * (4 * lambda^2 * deltaG(TYPE('b)) + 4 * lambda^2 * C + 2 * K)"
unfolding L_def apply (intro mono_intros) using C by auto
also have "... = M"
unfolding M_def K_def by (auto simp add: algebra_simps power2_eq_square power3_eq_cube)
finally have "L ≤ M" by simp
text ‹After these preliminaries, we start the real argument per se, showing that triangles
are thin in the type b.›
have Thin: "infdist w (Gxz ∪ Gyz) ≤ M" if
H: "geodesic_segment_between Gxy x y" "geodesic_segment_between Gxz x z" "geodesic_segment_between Gyz y z" "w ∈ Gxy"
for w x y z::'a and Gxy Gyz Gxz
proof -
obtain w2 where w2: "w2 ∈ {f x--f y}" "infdist (f w) {f x--f y} = dist (f w) w2"
using infdist_proper_attained[OF proper_of_compact, of "{f x--f y}" "f w"] by auto
have "dist (f w) w2 = infdist (f w) {f x-- f y}"
using w2 by simp
also have "... ≤ hausdorff_distance (f`Gxy) {f x-- f y}"
using geodesic_segment_topology(4)[OF geodesic_segmentI] H
by (auto intro!: quasi_isometry_on_bounded[OF quasi_isometry_on_subset[OF assms]] infdist_le_hausdorff_distance)
also have "... ≤ K" using HD[OF H(1)] by simp
finally have *: "dist (f w) w2 ≤ K" by simp
have "infdist w2 (f`Gxz ∪ f`Gyz) ≤ infdist w2 ({f x--f z} ∪ {f y--f z})
+ hausdorff_distance ({f x--f z} ∪ {f y--f z}) (f`Gxz ∪ f`Gyz)"
apply (rule hausdorff_distance_infdist_triangle)
using geodesic_segment_topology(4)[OF geodesic_segmentI] H
by (auto intro!: quasi_isometry_on_bounded[OF quasi_isometry_on_subset[OF assms]])
also have "... ≤ 4 * deltaG(TYPE('b)) + hausdorff_distance ({f x--f z} ∪ {f y--f z}) (f`Gxz ∪ f`Gyz)"
apply (simp, rule thin_triangles[of "{f x--f z}" "f z" "f x" "{f y--f z}" "f y" "{f x--f y}" w2])
using w2 apply auto
using geodesic_segment_commute some_geodesic_is_geodesic_segment(1) by blast+
also have "... ≤ 4 * deltaG(TYPE('b)) + max (hausdorff_distance {f x--f z} (f`Gxz)) (hausdorff_distance {f y--f z} (f`Gyz))"
apply (intro mono_intros) using H by auto
also have "... ≤ 4 * deltaG(TYPE('b)) + K"
using HD[OF H(2)] HD[OF H(3)] by (auto simp add: hausdorff_distance_sym)
finally have **: "infdist w2 (f`Gxz ∪ f`Gyz) ≤ 4 * deltaG(TYPE('b)) + K" by simp
have "infdist (f w) (f`Gxz ∪ f`Gyz) ≤ infdist w2 (f`Gxz ∪ f`Gyz) + dist (f w) w2"
by (rule infdist_triangle)
then have A: "infdist (f w) (f`(Gxz ∪ Gyz)) ≤ 4 * deltaG(TYPE('b)) + 2 * K"
using * ** by (auto simp add: image_Un)
have "infdist w (Gxz ∪ Gyz) ≤ L + epsilon" if "epsilon > 0" for epsilon
proof -
have *: "epsilon/lambda > 0" using that C by auto
have "∃z ∈ f`(Gxz ∪ Gyz). dist (f w) z < 4 * deltaG(TYPE('b)) + 2 * K + epsilon/lambda"
apply (rule infdist_almost_attained)
using A * H(2) by auto
then obtain z where z: "z ∈ Gxz ∪ Gyz" "dist (f w) (f z) < 4 * deltaG(TYPE('b)) + 2 * K + epsilon/lambda"
by auto
have "infdist w (Gxz ∪ Gyz) ≤ dist w z"
by (auto intro!: infdist_le z(1))
also have "... ≤ lambda * dist (f w) (f z) + C * lambda"
using quasi_isometry_onD[OF assms] by (auto simp add: algebra_simps divide_simps)
also have "... ≤ lambda * (4 * deltaG(TYPE('b)) + 2 * K + epsilon/lambda) + C * lambda"
apply (intro mono_intros) using z(2) C by auto
also have "... = L + epsilon"
unfolding K_def L_def using C by (auto simp add: algebra_simps)
finally show ?thesis by simp
qed
then have "infdist w (Gxz ∪ Gyz) ≤ L"
using field_le_epsilon by blast
then show ?thesis
using ‹L ≤ M› by auto
qed
then have "Gromov_hyperbolic_subset (4 * M) (UNIV::'a set)"
using thin_triangles_implies_hyperbolic[OF Thin] by auto
then show ?thesis unfolding M_def by (auto simp add: algebra_simps)
qed
text ‹Most often, the precise value of the constant in the previous theorem is irrelevant,
it is used in the following form.›
theorem Gromov_hyperbolic_invariant_under_quasi_isometry:
assumes "quasi_isometric (UNIV::('a::geodesic_space) set) (UNIV::('b::Gromov_hyperbolic_space_geodesic) set)"
shows "∃delta. Gromov_hyperbolic_subset delta (UNIV::'a set)"
proof -
obtain C lambda f where f: "lambda C-quasi_isometry_between (UNIV::'a set) (UNIV::'b set) f"
using assms unfolding quasi_isometric_def by auto
show ?thesis
using Gromov_hyperbolic_invariant_under_quasi_isometry_explicit[OF quasi_isometry_betweenD(1)[OF f]] by blast
qed
text ‹A central feature of hyperbolic spaces is that a path from $x$ to $y$ can not deviate
too much from a geodesic from $x$ to $y$ unless it is extremely long (exponentially long in
terms of the distance from $x$ to $y$). This is useful both to ensure that short paths (for instance
quasi-geodesics) stay close to geodesics, see the Morse lemme below, and to ensure that paths
that avoid a given large ball of radius $R$ have to be exponentially long in terms of $R$ (this
is extremely useful for random walks). This proposition is the first non-trivial result
on hyperbolic spaces in~\cite{bridson_haefliger} (Proposition III.H.1.6). We follow their proof.
The proof is geometric, and uses the existence of geodesics and the fact that geodesic
triangles are thin. In fact, the result still holds if the space is not geodesic, as
it can be deduced by embedding the hyperbolic space in a geodesic hyperbolic space and using
the result there.›
proposition (in Gromov_hyperbolic_space_geodesic) lipschitz_path_close_to_geodesic:
fixes c::"real ⇒ 'a"
assumes "M-lipschitz_on {A..B} c"
"geodesic_segment_between G (c A) (c B)"
"x ∈ G"
shows "infdist x (c`{A..B}) ≤ (4/ln 2) * deltaG(TYPE('a)) * max 0 (ln (B-A)) + M"
proof -
have "M ≥ 0" by (rule lipschitz_on_nonneg[OF assms(1)])
have Main: "a ∈ {A..B} ⟹ b ∈ {A..B} ⟹ a ≤ b ⟹ b-a ≤ 2^(n+1) ⟹ geodesic_segment_between H (c a) (c b)
⟹ y ∈ H ⟹ infdist y (c`{A..B}) ≤ 4 * deltaG(TYPE('a)) * n + M" for a b H y n
proof (induction n arbitrary: a b H y)
case 0
have "infdist y (c ` {A..B}) ≤ dist y (c b)"
apply (rule infdist_le) using ‹b ∈ {A..B}› by auto
moreover have "infdist y (c ` {A..B}) ≤ dist y (c a)"
apply (rule infdist_le) using ‹a ∈ {A..B}› by auto
ultimately have "2 * infdist y (c ` {A..B}) ≤ dist (c a) y + dist y (c b)"
by (auto simp add: metric_space_class.dist_commute)
also have "... = dist (c a) (c b)"
by (rule geodesic_segment_dist[OF ‹geodesic_segment_between H (c a) (c b)› ‹y ∈ H›])
also have "... ≤ M * abs(b - a)"
using lipschitz_onD(1)[OF assms(1) ‹a ∈ {A..B}› ‹b ∈ {A..B}›] unfolding dist_real_def
by (simp add: abs_minus_commute)
also have "... ≤ M * 2"
using ‹a ≤ b› ‹b - a ≤ 2^(0 + 1)› ‹M ≥ 0› mult_left_mono by auto
finally show ?case by simp
next
case (Suc n)
define m where "m = (a + b)/2"
have "m ∈ {A..B}" using ‹a ∈ {A..B}› ‹b ∈ {A..B}› unfolding m_def by auto
define Ha where "Ha = {c m--c a}"
define Hb where "Hb = {c m--c b}"
have I: "geodesic_segment_between Ha (c m) (c a)" "geodesic_segment_between Hb (c m) (c b)"
unfolding Ha_def Hb_def by auto
then have "Ha ≠ {}" "Hb ≠ {}" "compact Ha" "compact Hb"
by (auto intro: geodesic_segment_topology)
have *: "infdist y (Ha ∪ Hb) ≤ 4 * deltaG(TYPE('a))"
by (rule thin_triangles[OF I ‹geodesic_segment_between H (c a) (c b)› ‹y ∈ H›])
then have "infdist y Ha ≤ 4 * deltaG(TYPE('a)) ∨ infdist y Hb ≤ 4 * deltaG(TYPE('a))"
unfolding infdist_union_min[OF ‹Ha ≠ {}› ‹Hb ≠ {}›] by auto
then show ?case
proof
assume H: "infdist y Ha ≤ 4 * deltaG TYPE('a)"
obtain z where z: "z ∈ Ha" "infdist y Ha = dist y z"
using infdist_proper_attained[OF proper_of_compact[OF ‹compact Ha›] ‹Ha ≠ {}›] by auto
have Iz: "infdist z (c`{A..B}) ≤ 4 * deltaG(TYPE('a)) * n + M"
proof (rule Suc.IH[OF ‹a ∈ {A..B}› ‹m ∈ {A..B}›, of Ha])
show "a ≤ m" unfolding m_def using ‹a ≤ b› by auto
show "m - a ≤ 2^(n+1)" using ‹b - a ≤ 2^(Suc n + 1)› ‹a ≤ b› unfolding m_def by auto
show "geodesic_segment_between Ha (c a) (c m)" by (simp add: I(1) geodesic_segment_commute)
show "z ∈ Ha" using z by auto
qed
have "infdist y (c`{A..B}) ≤ dist y z + infdist z (c`{A..B})"
by (metis add.commute infdist_triangle)
also have "... ≤ 4 * deltaG TYPE('a) + (4 * deltaG(TYPE('a)) * n + M)"
using H z Iz by (auto intro: add_mono)
finally show "infdist y (c ` {A..B}) ≤ 4 * deltaG TYPE('a) * real (Suc n) + M"
by (auto simp add: algebra_simps)
next
assume H: "infdist y Hb ≤ 4 * deltaG TYPE('a)"
obtain z where z: "z ∈ Hb" "infdist y Hb = dist y z"
using infdist_proper_attained[OF proper_of_compact[OF ‹compact Hb›] ‹Hb ≠ {}›] by auto
have Iz: "infdist z (c`{A..B}) ≤ 4 * deltaG(TYPE('a)) * n + M"
proof (rule Suc.IH[OF ‹m ∈ {A..B}› ‹b ∈ {A..B}›, of Hb])
show "m ≤ b" unfolding m_def using ‹a ≤ b› by auto
show "b - m ≤ 2^(n+1)" using ‹b - a ≤ 2^(Suc n + 1)› ‹a ≤ b›
unfolding m_def by (auto simp add: divide_simps)
show "geodesic_segment_between Hb (c m) (c b)" by (simp add: I(2))
show "z ∈ Hb" using z by auto
qed
have "infdist y (c`{A..B}) ≤ dist y z + infdist z (c`{A..B})"
by (metis add.commute infdist_triangle)
also have "... ≤ 4 * deltaG TYPE('a) + (4 * deltaG(TYPE('a)) * n + M)"
using H z Iz by (auto intro: add_mono)
finally show "infdist y (c ` {A..B}) ≤ 4 * deltaG TYPE('a) * real (Suc n) + M"
by (auto simp add: algebra_simps)
qed
qed
consider "B-A <0" | "B-A ≥ 0 ∧ B-A ≤ 2" | "B-A > 2" by linarith
then show ?thesis
proof (cases)
case 1
then have "c`{A..B} = {}" by auto
then show ?thesis unfolding infdist_def using ‹M ≥ 0› by auto
next
case 2
have "infdist x (c`{A..B}) ≤ 4 * deltaG(TYPE('a)) * real 0 + M"
apply (rule Main[OF _ _ _ _ ‹geodesic_segment_between G (c A) (c B)› ‹x ∈ G›])
using 2 by auto
also have "... ≤ (4/ln 2) * deltaG(TYPE('a)) * max 0 (ln (B-A)) + M"
using delta_nonneg by auto
finally show ?thesis by auto
next
case 3
define n::nat where "n = nat(floor (log 2 (B-A)))"
have "log 2 (B-A) > 0" using 3 by auto
then have n: "n ≤ log 2 (B-A)" "log 2 (B-A) < n+1"
unfolding n_def by (auto simp add: floor_less_cancel)
then have *: "B-A ≤ 2^(n+1)"
by (meson le_log_of_power linear not_less one_less_numeral_iff semiring_norm(76))
have "n ≤ ln (B-A) * (1/ln 2)" using n unfolding log_def by auto
then have "n ≤ (1/ln 2) * max 0 (ln (B-A))"
using 3 by (auto simp add: algebra_simps divide_simps)
have "infdist x (c`{A..B}) ≤ 4 * deltaG(TYPE('a)) * n + M"
apply (rule Main[OF _ _ _ _ ‹geodesic_segment_between G (c A) (c B)› ‹x ∈ G›])
using * 3 by auto
also have "... ≤ 4 * deltaG(TYPE('a)) * ((1/ln 2) * max 0 (ln (B-A))) + M"
apply (intro mono_intros) using ‹n ≤ (1/ln 2) * max 0 (ln (B-A))› delta_nonneg by auto
finally show ?thesis by auto
qed
qed
text ‹By rescaling coordinates at the origin, one obtains a variation around the previous
statement.›
proposition (in Gromov_hyperbolic_space_geodesic) lipschitz_path_close_to_geodesic':
fixes c::"real ⇒ 'a"
assumes "M-lipschitz_on {A..B} c"
"geodesic_segment_between G (c A) (c B)"
"x ∈ G"
"a > 0"
shows "infdist x (c`{A..B}) ≤ (4/ln 2) * deltaG(TYPE('a)) * max 0 (ln (a * (B-A))) + M/a"
proof -
define d where "d = c o (λt. (1/a) * t)"
have *: "(M * ((1/a)* 1))-lipschitz_on {a * A..a * B} d"
unfolding d_def apply (rule lipschitz_on_compose, intro lipschitz_intros) using assms by auto
have "d`{a * A..a * B} = c`{A..B}"
unfolding d_def image_comp[symmetric]
apply (rule arg_cong[where ?f = "image c"]) using ‹a > 0› by auto
then have "infdist x (c`{A..B}) = infdist x (d`{a * A..a * B})" by auto
also have "... ≤ (4/ln 2) * deltaG(TYPE('a)) * max 0 (ln ((a * B)- (a * A))) + M/a"
apply (rule lipschitz_path_close_to_geodesic[OF _ _ ‹x ∈ G›])
using * assms unfolding d_def by auto
finally show ?thesis by (auto simp add: algebra_simps)
qed
text ‹We can now give another proof of the Morse-Gromov Theorem, as described
in~\cite{bridson_haefliger}. It is more direct than the one we have given above, but it gives
a worse dependence in terms of the quasi-isometry constants. In particular, when $C = \delta = 0$,
it does not recover the fact that a quasi-geodesic has to coincide with a geodesic.›
theorem (in Gromov_hyperbolic_space_geodesic) Morse_Gromov_theorem_BH_proof:
fixes c::"real ⇒ 'a"
assumes "lambda C-quasi_isometry_on {A..B} c"
shows "hausdorff_distance (c`{A..B}) {c A--c B} ≤ 72 * lambda^2 * (C + lambda + deltaG(TYPE('a))^2)"
proof -
have C: "C ≥ 0" "lambda ≥ 1" using quasi_isometry_onD[OF assms] by auto
consider "B-A < 0" | "B-A ≥ 0 ∧ dist (c A) (c B) ≤ 2 * C" | "B-A ≥ 0 ∧ dist (c A) (c B) > 2 * C" by linarith
then show ?thesis
proof (cases)
case 1
then have "c`{A..B} = {}" by auto
then show ?thesis unfolding hausdorff_distance_def using delta_nonneg C by auto
next
case 2
have "(1/lambda) * dist A B - C ≤ dist (c A) (c B)"
apply (rule quasi_isometry_onD[OF assms]) using 2 by auto
also have "... ≤ 2 * C" using 2 by auto
finally have "dist A B ≤ 3 * lambda * C"
using C by (auto simp add: algebra_simps divide_simps)
then have *: "B - A ≤ 3 * lambda * C" using 2 unfolding dist_real_def by auto
show ?thesis
proof (rule hausdorff_distanceI2)
show "0 ≤ 72 * lambda^2 * (C + lambda + deltaG(TYPE('a))^2)" using C by auto
fix x assume "x ∈ c`{A..B}"
then obtain t where t: "x = c t" "t ∈ {A..B}" by auto
have "dist x (c A) ≤ lambda * dist t A + C"
unfolding t(1) using quasi_isometry_onD(1)[OF assms t(2), of A] 2 by auto
also have "... ≤ lambda * (B-A) + C" using t(2) 2 C unfolding dist_real_def by auto
also have "... ≤ 3 * lambda * lambda * C + 1 * 1 * C" using * C by auto
also have "... ≤ 3 * lambda * lambda * C + lambda * lambda * C"
apply (intro mono_intros) using C by auto
also have "... = 4 * lambda * lambda * (C + 0 + 0^2)"
by auto
also have "... ≤ 72 * lambda * lambda * (C + lambda + deltaG(TYPE('a))^2)"
apply (intro mono_intros) using C delta_nonneg by auto
finally have *: "dist x (c A) ≤ 72 * lambda^2 * (C + lambda + deltaG(TYPE('a))^2)"
unfolding power2_eq_square by simp
show "∃y∈{c A--c B}. dist x y ≤ 72 * lambda^2 * (C + lambda + deltaG(TYPE('a))^2)"
apply (rule bexI[of _ "c A"]) using * by auto
next
fix x assume "x ∈ {c A-- c B}"
then have "dist x (c A) ≤ dist (c A) (c B)"
by (meson geodesic_segment_dist_le geodesic_segment_endpoints(1) local.some_geodesic_is_geodesic_segment(1))
also have "... ≤ 2 * C"
using 2 by auto
also have "... ≤ 2 * 1 * 1 * (C + lambda + 0)" using 2 C unfolding dist_real_def by auto
also have "... ≤ 72 * lambda * lambda * (C + lambda + deltaG(TYPE('a)) * deltaG(TYPE('a)))"
apply (intro mono_intros) using C delta_nonneg by auto
finally have *: "dist x (c A) ≤ 72 * lambda * lambda * (C + lambda + deltaG(TYPE('a)) * deltaG(TYPE('a)))"
by simp
show "∃y∈c`{A..B}. dist x y ≤ 72 * lambda^2 * (C + lambda + deltaG(TYPE('a))^2)"
apply (rule bexI[of _ "c A"]) unfolding power2_eq_square using * 2 by auto
qed
next
case 3
then obtain d where d: "continuous_on {A..B} d" "d A = c A" "d B = c B"
"⋀x. x ∈ {A..B} ⟹ dist (c x) (d x) ≤ 4 *C"
"lambda (4 * C)-quasi_isometry_on {A..B} d"
"(2 * lambda)-lipschitz_on {A..B} d"
"hausdorff_distance (c`{A..B}) (d`{A..B}) ≤ 2 * C"
using quasi_geodesic_made_lipschitz[OF assms] C(1) by fastforce
have "A ∈ {A..B}" "B ∈ {A..B}" using 3 by auto
text ‹We show that the distance of any point in the geodesic from $c(A)$ to $c(B)$ is a bounded
distance away from the quasi-geodesic $d$, by considering a point $x$ where the distance $D$ is
maximal and arguing around this point.
Consider the point $x_m$ on the geodesic $[c(A), c(B)]$ at distance $2D$ from $x$, and the closest
point $y_m$ on the image of $d$. Then the distance between $x_m$ and $y_m$ is at most $D$. Hence
a point on $[x_m,y_m]$ is at distance at least $2D - D = D$ of $x$. In the same way, define $x_M$
and $y_M$ on the other side of $x$. Then the excursion from $x_m$ to $y_m$, then to $y_M$ along
$d$, then to $x_M$, has length at most $D + (\lambda \cdot 6D + C) + D$ and is always at distance
at least $D$ from $x$. It follows from the previous lemma that $D \leq \log(length)$, which
implies a bound on $D$.
This argument has to be amended if $x$ is at distance $ < 2D$ from $c(A)$ or $c(B)$. In this case,
simply use $x_m = y_m = c(A)$ or $x_M = y_M = c(B)$, then everything goes through.›
have "∃x ∈ {c A--c B}. ∀y ∈ {c A--c B}. infdist y (d`{A..B}) ≤ infdist x (d`{A..B})"
by (rule continuous_attains_sup, auto intro: continuous_intros)
then obtain x where x: "x ∈ {c A--c B}" "⋀y. y ∈ {c A--c B} ⟹ infdist y (d`{A..B}) ≤ infdist x (d`{A..B})"
by auto
define D where "D = infdist x (d`{A..B})"
have "D ≥ 0" unfolding D_def by (rule infdist_nonneg)
have D_bound: "D ≤ 24 * lambda + 12 * C + 24 * deltaG(TYPE('a))^2"
proof (cases "D ≤ 1")
case True
have "1 * 1 + 1 * 0 + 0 * 0 ≤ 24 * lambda + 12 * C + 24 * deltaG(TYPE('a))^2"
apply (intro mono_intros) using C delta_nonneg by auto
then show ?thesis using True by auto
next
case False
then have "D ≥ 1" by auto
have ln2mult: "2 * ln t = ln (t * t)" if "t > 0" for t::real by (simp add: that ln_mult)
have "infdist (c A) (d`{A..B}) = 0" using ‹d A = c A› by (metis ‹A ∈ {A..B}› image_eqI infdist_zero)
then have "x ≠ c A" using ‹D ≥ 1› D_def by auto
define tx where "tx = dist (c A) x"
then have "tx ∈ {0..dist (c A) (c B)}"
using ‹x ∈ {c A--c B}›
by (meson atLeastAtMost_iff geodesic_segment_dist_le some_geodesic_is_geodesic_segment(1) metric_space_class.zero_le_dist some_geodesic_endpoints(1))
have "tx > 0" using ‹x ≠ c A› tx_def by auto
have x_param: "x = geodesic_segment_param {c A--c B} (c A) tx"
using ‹x ∈ {c A--c B}› geodesic_segment_param[OF some_geodesic_is_geodesic_segment(1)] tx_def by auto
define tm where "tm = max (tx - 2 * D) 0"
have "tm ∈ {0..dist (c A) (c B)}" unfolding tm_def using ‹tx ∈ {0..dist (c A) (c B)}› ‹D ≥ 0› by auto
define xm where "xm = geodesic_segment_param {c A--c B} (c A) tm"
have "xm ∈ {c A--c B}" using ‹tm ∈ {0..dist (c A) (c B)}›
by (metis geodesic_segment_param(3) local.some_geodesic_is_geodesic_segment(1) xm_def)
have "dist xm x = abs((max (tx - 2 * D) 0) - tx)"
unfolding xm_def tm_def x_param apply (rule geodesic_segment_param[of _ _ "c B"], auto)
using ‹tx ∈ {0..dist (c A) (c B)}› ‹D ≥ 0› by auto
also have "... ≤ 2 * D" by (simp add: ‹0 ≤ D› tx_def)
finally have "dist xm x ≤ 2 * D" by auto
have "∃ym∈d`{A..B}. infdist xm (d`{A..B}) = dist xm ym"
apply (rule infdist_proper_attained) using 3 d(1) proper_of_compact compact_continuous_image by auto
then obtain ym where ym: "ym ∈ d`{A..B}" "dist xm ym = infdist xm (d`{A..B})"
by metis
then obtain um where um: "um ∈ {A..B}" "ym = d um" by auto
have "dist xm ym ≤ D"
unfolding D_def using x ym by (simp add: ‹xm ∈ {c A--c B}›)
have D1: "dist x z ≥ D" if "z ∈ {xm--ym}" for z
proof (cases "tx - 2 * D < 0")
case True
then have "tm = 0" unfolding tm_def by auto
then have "xm = c A" unfolding xm_def
by (meson geodesic_segment_param(1) local.some_geodesic_is_geodesic_segment(1))
then have "infdist xm (d`{A..B}) = 0"
using ‹d A = c A› ‹A ∈ {A..B}› by (metis image_eqI infdist_zero)
then have "ym = xm" using ym(2) by auto
then have "z = xm" using ‹z ∈ {xm--ym}› geodesic_segment_between_x_x(3)
by (metis empty_iff insert_iff some_geodesic_is_geodesic_segment(1))
then have "z ∈ d`{A..B}" using ‹ym = xm› ym(1) by blast
then show "dist x z ≥ D" unfolding D_def by (simp add: infdist_le)
next
case False
then have *: "tm = tx - 2 * D" unfolding tm_def by auto
have "dist xm x = abs((tx - 2 * D) - tx)"
unfolding xm_def x_param * apply (rule geodesic_segment_param[of _ _ "c B"], auto)
using False ‹tx ∈ {0..dist (c A) (c B)}› ‹D ≥ 0› by auto
then have "2 * D = dist xm x" using ‹D ≥ 0› by auto
also have "... ≤ dist xm z + dist x z" using metric_space_class.dist_triangle2 by auto
also have "... ≤ dist xm ym + dist x z"
using ‹z ∈ {xm--ym}› by (auto, meson geodesic_segment_dist_le some_geodesic_is_geodesic_segment(1) some_geodesic_endpoints(1))
also have "... ≤ D + dist x z"
using ‹dist xm ym ≤ D› by simp
finally show "dist x z ≥ D" by auto
qed
define tM where "tM = min (tx + 2 * D) (dist (c A) (c B))"
have "tM ∈ {0..dist (c A) (c B)}" unfolding tM_def using ‹tx ∈ {0..dist (c A) (c B)}› ‹D ≥ 0› by auto
have "tm ≤ tM"
unfolding tM_def using ‹D ≥ 0› ‹tm ∈ {0..dist (c A) (c B)}› ‹tx ≡ dist (c A) x› tm_def by auto
define xM where "xM = geodesic_segment_param {c A--c B} (c A) tM"
have "xM ∈ {c A--c B}" using ‹tM ∈ {0..dist (c A) (c B)}›
by (metis geodesic_segment_param(3) local.some_geodesic_is_geodesic_segment(1) xM_def)
have "dist xM x = abs((min (tx + 2 * D) (dist (c A) (c B))) - tx)"
unfolding xM_def tM_def x_param apply (rule geodesic_segment_param[of _ _ "c B"], auto)
using ‹tx ∈ {0..dist (c A) (c B)}› ‹D ≥ 0› by auto
also have "... ≤ 2 * D" using ‹0 ≤ D› ‹tx ∈ {0..dist (c A) (c B)}› by auto
finally have "dist xM x ≤ 2 * D" by auto
have "∃yM∈d`{A..B}. infdist xM (d`{A..B}) = dist xM yM"
apply (rule infdist_proper_attained) using 3 d(1) proper_of_compact compact_continuous_image by auto
then obtain yM where yM: "yM ∈ d`{A..B}" "dist xM yM = infdist xM (d`{A..B})"
by metis
then obtain uM where uM: "uM ∈ {A..B}" "yM = d uM" by auto
have "dist xM yM ≤ D"
unfolding D_def using x yM by (simp add: ‹xM ∈ {c A--c B}›)
have D3: "dist x z ≥ D" if "z ∈ {xM--yM}" for z
proof (cases "tx + 2 * D > dist (c A) (c B)")
case True
then have "tM = dist (c A) (c B)" unfolding tM_def by auto
then have "xM = c B" unfolding xM_def
by (meson geodesic_segment_param(2) local.some_geodesic_is_geodesic_segment(1))
then have "infdist xM (d`{A..B}) = 0"
using ‹d B = c B› ‹B ∈ {A..B}› by (metis image_eqI infdist_zero)
then have "yM = xM" using yM(2) by auto
then have "z = xM" using ‹z ∈ {xM--yM}› geodesic_segment_between_x_x(3)
by (metis empty_iff insert_iff some_geodesic_is_geodesic_segment(1))
then have "z ∈ d`{A..B}" using ‹yM = xM› yM(1) by blast
then show "dist x z ≥ D" unfolding D_def by (simp add: infdist_le)
next
case False
then have *: "tM = tx + 2 * D" unfolding tM_def by auto
have "dist xM x = abs((tx + 2 * D) - tx)"
unfolding xM_def x_param * apply (rule geodesic_segment_param[of _ _ "c B"], auto)
using False ‹tx ∈ {0..dist (c A) (c B)}› ‹D ≥ 0› by auto
then have "2 * D = dist xM x" using ‹D ≥ 0› by auto
also have "... ≤ dist xM z + dist x z" using metric_space_class.dist_triangle2 by auto
also have "... ≤ dist xM yM + dist x z"
using ‹z ∈ {xM--yM}› by (auto, meson geodesic_segment_dist_le local.some_geodesic_is_geodesic_segment(1) some_geodesic_endpoints(1))
also have "... ≤ D + dist x z"
using ‹dist xM yM ≤ D› by simp
finally show "dist x z ≥ D" by auto
qed
define excursion:: "real⇒'a" where "excursion = (λt.
if t ∈ {0..dist xm ym} then (geodesic_segment_param {xm--ym} xm t)
else if t ∈ {dist xm ym..dist xm ym + abs(uM - um)} then d (um + sgn(uM-um) * (t - dist xm ym))
else geodesic_segment_param {yM--xM} yM (t - dist xm ym - abs (uM -um)))"
define L where "L = dist xm ym + abs(uM - um) + dist yM xM"
have E1: "excursion t = geodesic_segment_param {xm--ym} xm t" if "t ∈ {0..dist xm ym}" for t
unfolding excursion_def using that by auto
have E2: "excursion t = d (um + sgn(uM-um) * (t - dist xm ym))" if "t ∈ {dist xm ym..dist xm ym + abs(uM - um)}" for t
unfolding excursion_def using that by (auto simp add: ‹ym = d um›)
have E3: "excursion t = geodesic_segment_param {yM--xM} yM (t - dist xm ym - abs (uM -um))"
if "t ∈ {dist xm ym + ¦uM - um¦..dist xm ym + ¦uM - um¦ + dist yM xM}" for t
unfolding excursion_def using that ‹yM = d uM› ‹ym = d um› by (auto simp add: sgn_mult_abs)
have E0: "excursion 0 = xm"
unfolding excursion_def by auto
have EL: "excursion L = xM"
unfolding excursion_def L_def apply (auto simp add: uM(2) um(2) sgn_mult_abs)
by (metis (mono_tags, hide_lams) add.left_neutral add_increasing2 add_le_same_cancel1 dist_real_def
Gromov_product_e_x_x Gromov_product_nonneg metric_space_class.dist_le_zero_iff)
have [simp]: "L ≥ 0" unfolding L_def by auto
have "L > 0"
proof (rule ccontr)
assume "¬(L > 0)"
then have "L = 0" using ‹L ≥ 0› by simp
then have "xm = xM" using E0 EL by auto
then have "tM = tm" unfolding xm_def xM_def
using ‹tM ∈ {0..dist (c A) (c B)}› ‹tm ∈ {0..dist (c A) (c B)}› local.geodesic_segment_param_in_geodesic_spaces(6) by fastforce
also have "... < tx" unfolding tm_def using ‹tx > 0› ‹D ≥ 1› by auto
also have "... ≤ tM" unfolding tM_def using ‹D ≥ 0› ‹tx ∈ {0..dist (c A) (c B)}› by auto
finally show False by simp
qed
have "(1/lambda) * dist um uM - (4 * C) ≤ dist (d um) (d uM)"
by (rule quasi_isometry_onD(2)[OF ‹lambda (4 * C)-quasi_isometry_on {A..B} d› ‹um ∈ {A..B}› ‹uM ∈ {A..B}›])
also have "... ≤ dist ym xm + dist xm x + dist x xM + dist xM yM"
unfolding um(2)[symmetric] uM(2)[symmetric] by (rule dist_triangle5)
also have "... ≤ D + (2*D) + (2*D) + D"
using ‹dist xm ym ≤ D› ‹dist xm x ≤ 2*D› ‹dist xM x ≤ 2*D› ‹dist xM yM ≤ D›
by (auto simp add: metric_space_class.dist_commute intro: add_mono)
finally have "(1/lambda) * dist um uM ≤ 6*D + 4*C" by auto
then have "dist um uM ≤ 6*D*lambda + 4*C*lambda"
using C by (auto simp add: divide_simps algebra_simps)
then have "L ≤ D + (6*D*lambda + 4*C*lambda) + D"
unfolding L_def dist_real_def using ‹dist xm ym ≤ D› ‹dist xM yM ≤ D›
by (auto simp add: metric_space_class.dist_commute intro: add_mono)
also have "... ≤ 8 * D * lambda + 4*C*lambda"
using C ‹D ≥ 0› by (auto intro: mono_intros)
finally have L_bound: "L ≤ lambda * (8 * D + 4 * C)"
by (auto simp add: algebra_simps)
have "1 * (1 * 1 + 0) ≤ lambda * (8 * D + 4 * C)"
using C ‹D ≥ 1› by (intro mono_intros, auto)
consider "um < uM" | "um = uM" | "um > uM" by linarith
then have "((λt. um + sgn (uM - um) * (t - dist xm ym)) ` {dist xm ym..dist xm ym + ¦uM - um¦}) ⊆ {min um uM..max um uM}"
by (cases, auto)
also have "... ⊆ {A..B}" using ‹um ∈ {A..B}› ‹uM ∈ {A..B}› by auto
finally have middle: "((λt. um + sgn (uM - um) * (t - dist xm ym)) ` {dist xm ym..dist xm ym + ¦uM - um¦}) ⊆ {A..B}"
by simp
have "(2 * lambda)-lipschitz_on {0..L} excursion"
proof (unfold L_def, rule lipschitz_on_closed_Union[of "{{0..dist xm ym}, {dist xm ym..dist xm ym + abs(uM - um)}, {dist xm ym + abs(uM - um)..dist xm ym + abs(uM - um) + dist yM xM}}" _ "λ i. i"], auto)
show "lambda ≥ 0" using C by auto
have *: "1-lipschitz_on {0..dist xm ym} (geodesic_segment_param {xm--ym} xm)"
by (rule isometry_on_lipschitz, simp)
have **: "1-lipschitz_on {0..dist xm ym} excursion"
using lipschitz_on_transform[OF * E1] by simp
show "(2 * lambda)-lipschitz_on {0..dist xm ym} excursion"
apply (rule lipschitz_on_mono[OF **]) using C by auto
have *: "(1*(1+0))-lipschitz_on {dist xm ym + ¦uM - um¦..dist xm ym + ¦uM - um¦ + dist yM xM}
((geodesic_segment_param {yM--xM} yM) o (λt. t - (dist xm ym + abs (uM -um))))"
by (intro lipschitz_intros, rule isometry_on_lipschitz, auto)
have **: "(1*(1+0))-lipschitz_on {dist xm ym + ¦uM - um¦..dist xm ym + ¦uM - um¦ + dist yM xM} excursion"
apply (rule lipschitz_on_transform[OF *]) using E3 unfolding comp_def by (auto simp add: algebra_simps)
show "(2 * lambda)-lipschitz_on {dist xm ym + ¦uM - um¦..dist xm ym + ¦uM - um¦ + dist yM xM} excursion"
apply (rule lipschitz_on_mono[OF **]) using C by auto
have **: "((2 * lambda) * (0 + abs(sgn (uM - um)) * (1 + 0)))-lipschitz_on {dist xm ym..dist xm ym + abs(uM - um)} (d o (λt. um + sgn(uM-um) * (t - dist xm ym)))"
apply (intro lipschitz_intros, rule lipschitz_on_subset[OF _ middle])
using ‹(2 * lambda)-lipschitz_on {A..B} d› by simp
have ***: "(2 * lambda)-lipschitz_on {dist xm ym..dist xm ym + abs(uM - um)} (d o (λt. um + sgn(uM-um) * (t - dist xm ym)))"
apply (rule lipschitz_on_mono[OF **]) using C by auto
show "(2 * lambda)-lipschitz_on {dist xm ym..dist xm ym + abs(uM - um)} excursion"
apply (rule lipschitz_on_transform[OF ***]) using E2 by auto
qed
have *: "dist x z ≥ D" if z: "z ∈ excursion`{0..L}" for z
proof -
obtain tz where tz: "z = excursion tz" "tz ∈ {0..dist xm ym + abs(uM - um) + dist yM xM}"
using z L_def by auto
consider "tz ∈ {0..dist xm ym}" | "tz ∈ {dist xm ym<..dist xm ym + abs(uM - um)}" | "tz ∈ {dist xm ym + abs(uM - um)<..dist xm ym + abs(uM - um) + dist yM xM}"
using tz by force
then show ?thesis
proof (cases)
case 1
then have "z ∈ {xm--ym}" unfolding tz(1) excursion_def by auto
then show ?thesis using D1 by auto
next
case 3
then have "z ∈ {yM--xM}" unfolding tz(1) excursion_def using tz(2) by auto
then show ?thesis using D3 by (simp add: some_geodesic_commute)
next
case 2
then have "z ∈ d`{A..B}" unfolding tz(1) excursion_def using middle by force
then show ?thesis unfolding D_def by (simp add: infdist_le)
qed
qed
text ‹Now comes the main point: the excursion is always at distance at least $D$ of $x$,
but this distance is also bounded by the log of its length, i.e., essentially $\log D$. To
have an efficient estimate, we use a rescaled version, to get rid of one term on the right
hand side.›
have "1 * 1 * 1 * (1 + 0/1) ≤ 512 * lambda * lambda * (1+C/D)"
apply (intro mono_intros) using ‹lambda ≥ 1› ‹D ≥ 1› ‹C ≥ 0› by auto
then have "ln (512 * lambda * lambda * (1+C/D)) ≥ 0"
apply (subst ln_ge_zero_iff) by auto
define a where "a = 64 * lambda/D"
have "a > 0" unfolding a_def using ‹D ≥ 1› ‹lambda ≥ 1› by auto
have "D ≤ infdist x (excursion`{0..L})"
unfolding infdist_def apply auto apply (rule cInf_greatest) using * by auto
also have "... ≤ (4/ln 2) * deltaG(TYPE('a)) * max 0 (ln (a * (L-0))) + (2 * lambda) / a"
proof (rule lipschitz_path_close_to_geodesic'[of _ _ _ _ "geodesic_subsegment {c A--c B} (c A) tm tM"])
show "(2 * lambda)-lipschitz_on {0..L} excursion" by fact
have *: "geodesic_subsegment {c A--c B} (c A) tm tM = geodesic_segment_param {c A--c B} (c A) ` {tm..tM} "
apply (rule geodesic_subsegment(1)[of _ _ "c B"])
using ‹tm ∈ {0..dist (c A) (c B)}› ‹tM ∈ {0..dist (c A) (c B)}› ‹tm ≤ tM› by auto
show "x ∈ geodesic_subsegment {c A--c B} (c A) tm tM"
unfolding * unfolding x_param tm_def tM_def using ‹tx ∈ {0..dist (c A) (c B)}› ‹0 ≤ D› by simp
show "geodesic_segment_between (geodesic_subsegment {c A--c B} (c A) tm tM) (excursion 0) (excursion L)"
unfolding E0 EL xm_def xM_def apply (rule geodesic_subsegment[of _ _ "c B"])
using ‹tm ∈ {0..dist (c A) (c B)}› ‹tM ∈ {0..dist (c A) (c B)}› ‹tm ≤ tM› by auto
qed (fact)
also have "... = (4/ln 2) * deltaG(TYPE('a)) * max 0 (ln (a *L)) + D/32"
unfolding a_def using ‹D ≥ 1› ‹lambda ≥ 1› by (simp add: algebra_simps)
finally have "(31 * ln 2 / 128) * D ≤ deltaG(TYPE('a)) * max 0 (ln (a * L))"
by (auto simp add: algebra_simps divide_simps)
also have "... ≤ deltaG(TYPE('a)) * max 0 (ln ((64 * lambda/D) * (lambda * (8 * D + 4 * C))))"
unfolding a_def apply (intro mono_intros)
using L_bound ‹L > 0› ‹lambda ≥ 1› ‹D ≥ 1› by auto
also have "... ≤ deltaG(TYPE('a)) * max 0 (ln ((64 * lambda/D) * (lambda * (8 * D + 8 * C))))"
apply (intro mono_intros)
using L_bound ‹L > 0› ‹lambda ≥ 1› ‹D ≥ 1› ‹C ≥ 0› by auto
also have "... = deltaG(TYPE('a)) * max 0 (ln (512 * lambda * lambda * (1+C/D)))"
using ‹D ≥ 1› by (auto simp add: algebra_simps)
also have "... = deltaG(TYPE('a)) * ln (512 * lambda * lambda * (1+C/D))"
using ‹ln (512 * lambda * lambda * (1+C/D)) ≥ 0› by auto
also have "... ≤ deltaG(TYPE('a)) * ln (512 * lambda * lambda * (1+C/1))"
apply (intro mono_intros) using ‹lambda ≥ 1› ‹C ≥ 0› ‹D ≥ 1›
by (auto simp add: divide_simps mult_ge1_mono(1))
text ‹We have obtained a bound on $D$, of the form $D \leq M \delta \ln(M \lambda^2(1+C))$.
This is a nice bound, but we tweak it a little bit to obtain something more manageable,
without the logarithm.›
also have "... = deltaG(TYPE('a)) * (ln 512 + 2 * ln lambda + ln (1+C))"
apply (subst ln2mult) using ‹C ≥ 0› ‹lambda ≥ 1› apply simp
apply (subst ln_mult[symmetric]) apply simp using ‹C ≥ 0› ‹lambda ≥ 1› apply simp
apply (subst ln_mult[symmetric]) using ‹C ≥ 0› ‹lambda ≥ 1› by auto
also have "... = (deltaG(TYPE('a)) * 1) * ln 512 + 2 * (deltaG(TYPE('a)) * ln lambda) + (deltaG(TYPE('a)) * ln (1+C))"
by (auto simp add: algebra_simps)
text ‹For each term, of the form $\delta \ln c$, we bound it by $(\delta^2 + (\ln c)^2)/2$, and
then bound $(\ln c)^2$ by $2c-2$. In fact, to get coefficients of the same order of
magnitude on $\delta^2$ and $\lambda$, we tweak a little bit the inequality for the last two
terms, using rather $uv \leq (u^2/2 + 2v^2)/2$. We also bound $\ln(32)$ by a good
approximation $16/3$.›
also have "... ≤ (deltaG(TYPE('a))^2/2 + 1^2/2) * (25/4)
+ 2 * ((1/2) * deltaG(TYPE('a))^2/2 + 2 * (ln lambda)^2 / 2) + ((1/2) * deltaG(TYPE('a))^2/2 + 2 * (ln (1+C))^2 / 2)"
by (intro mono_intros, auto, approximation 10)
also have "... = (31/8) * deltaG(TYPE('a))^2 + 25/8 + 2 * (ln lambda)^2 + (ln (1+C))^2"
by (auto simp add: algebra_simps)
also have "... ≤ 4 * deltaG(TYPE('a))^2 + 4 + 2 * (2 * lambda - 2) + (2 * (1+C) - 2)"
apply (intro mono_intros) using ‹C ≥ 0› ‹lambda ≥ 1› by auto
also have "... ≤ 4 * deltaG(TYPE('a))^2 + 4 * lambda + 2 * C"
by auto
finally have "D ≤ (128 / (31 * ln 2)) * (4 * deltaG(TYPE('a))^2 + 4 * lambda + 2 * C)"
by (auto simp add: divide_simps algebra_simps)
also have "... ≤ 6 * (4 * deltaG(TYPE('a))^2 + 4 * lambda + 2 * C)"
apply (intro mono_intros, approximation 10) using ‹lambda ≥ 1› ‹C ≥ 0› by auto
also have "... ≤ 24 * deltaG(TYPE('a))^2 + 24 * lambda + 12 * C"
using ‹lambda ≥ 1› ‹C ≥ 0› by auto
finally show ?thesis by simp
qed
define D0 where "D0 = 24 * lambda + 12 * C + 24 * deltaG(TYPE('a))^2"
have first_step: "infdist y (d`{A..B}) ≤ D0" if "y ∈ {c A--c B}" for y
using x(2)[OF that] D_bound unfolding D0_def D_def by auto
have "1 * 1 + 4 * 0 + 24 * 0 ≤ D0"
unfolding D0_def apply (intro mono_intros) using C delta_nonneg by auto
then have "D0 > 0" by simp
text ‹This is the end of the first step, i.e., showing that $[c(A), c(B)]$ is included in
the neighborhood of size $D0$ of the quasi-geodesic.›
text ‹Now, we start the second step: we show that the quasi-geodesic is included in the
neighborhood of size $D1$ of the geodesic, where $D1 \geq D0$ is the constant defined below.
The argument goes as follows. Assume that a point $y$ on the quasi-geodesic is at distance $ > D0$
of the geodesic. Consider the last point $y_m$ before $y$ which is at distance $D0$ of the
geodesic, and the first point $y_M$ after $y$ likewise. On $(y_m, y_M)$, one is always at distance
$ > D0$ of the geodesic. However, by the first step, the geodesic is covered by the balls of radius
$D0$ centered at points on the quasi-geodesic -- and only the points before $y_m$ or after $y_M$
can be used. Let $K_m$ be the points on the geodesics that are at distance $\leq D0$ of a point
on the quasi-geodesic before $y_m$, and likewise define $K_M$. These are two closed subsets of
the geodesic. By connectedness, they have to intersect. This implies that some points before $y_m$
and after $y_M$ are at distance at most $2D0$. Since we are dealing with a quasi-geodesic, this
gives a bound on the distance between $y_m$ and $y_M$, and therefore a bound between $y$ and the
geodesic, as desired.›
define D1 where "D1 = lambda * lambda * (72 * lambda + 44 * C + 72 * deltaG(TYPE('a))^2)"
have "1 * 1 * (24 * lambda + 12 * C + 24 * deltaG(TYPE('a))^2)
≤ lambda * lambda * (72 * lambda + 44 * C + 72 * deltaG(TYPE('a))^2)"
apply (intro mono_intros) using C by auto
then have "D0 ≤ D1" unfolding D0_def D1_def by auto
have second_step: "infdist y {c A--c B} ≤ D1" if "y ∈ d`{A..B}" for y
proof (cases "infdist y {c A--c B} ≤ D0")
case True
then show ?thesis using ‹D0 ≤ D1› by auto
next
case False
obtain ty where "ty ∈ {A..B}" "y = d ty" using ‹y ∈ d`{A..B}› by auto
define tm where "tm = Sup ((λt. infdist (d t) {c A--c B})-`{..D0} ∩ {A..ty})"
have tm: "tm ∈ (λt. infdist (d t) {c A--c B})-`{..D0} ∩ {A..ty}"
unfolding tm_def proof (rule closed_contains_Sup)
show "closed ((λt. infdist (d t) {c A--c B})-`{..D0} ∩ {A..ty})"
apply (rule closed_vimage_Int, auto, intro continuous_intros)
apply (rule continuous_on_subset[OF d(1)]) using ‹ty ∈ {A..B}› by auto
have "A ∈ (λt. infdist (d t) {c A--c B})-`{..D0} ∩ {A..ty}"
using ‹D0 > 0› ‹ty ∈ {A..B}› by (auto simp add: ‹d A = c A›)
then show "(λt. infdist (d t) {c A--c B})-`{..D0} ∩ {A..ty} ≠ {}" by auto
show "bdd_above ((λt. infdist (d t) {c A--c B}) -` {..D0} ∩ {A..ty})" by auto
qed
have *: "infdist (d t) {c A--c B} > D0" if "t ∈ {tm<..ty}" for t
proof (rule ccontr)
assume "¬(infdist (d t) {c A--c B} > D0)"
then have *: "t ∈ (λt. infdist (d t) {c A--c B})-`{..D0} ∩ {A..ty}"
using that tm by auto
have "t ≤ tm" unfolding tm_def apply (rule cSup_upper) using * by auto
then show False using that by auto
qed
define tM where "tM = Inf ((λt. infdist (d t) {c A--c B})-`{..D0} ∩ {ty..B})"
have tM: "tM ∈ (λt. infdist (d t) {c A--c B})-`{..D0} ∩ {ty..B}"
unfolding tM_def proof (rule closed_contains_Inf)
show "closed ((λt. infdist (d t) {c A--c B})-`{..D0} ∩ {ty..B})"
apply (rule closed_vimage_Int, auto, intro continuous_intros)
apply (rule continuous_on_subset[OF d(1)]) using ‹ty ∈ {A..B}› by auto
have "B ∈ (λt. infdist (d t) {c A--c B})-`{..D0} ∩ {ty..B}"
using ‹D0 > 0› ‹ty ∈ {A..B}› by (auto simp add: ‹d B = c B›)
then show "(λt. infdist (d t) {c A--c B})-`{..D0} ∩ {ty..B} ≠ {}" by auto
show "bdd_below ((λt. infdist (d t) {c A--c B}) -` {..D0} ∩ {ty..B})" by auto
qed
have "infdist (d t) {c A--c B} > D0" if "t ∈ {ty..<tM}" for t
proof (rule ccontr)
assume "¬(infdist (d t) {c A--c B} > D0)"
then have *: "t ∈ (λt. infdist (d t) {c A--c B})-`{..D0} ∩ {ty..B}"
using that tM by auto
have "t ≥ tM" unfolding tM_def apply (rule cInf_lower) using * by auto
then show False using that by auto
qed
then have lower_tm_tM: "infdist (d t) {c A--c B} > D0" if "t ∈ {tm<..<tM}" for t
using * that by (cases "t ≥ ty", auto)
define Km where "Km = (⋃z ∈ d`{A..tm}. cball z D0)"
define KM where "KM = (⋃z ∈ d`{tM..B}. cball z D0)"
have "{c A--c B} ⊆ Km ∪ KM"
proof
fix x assume "x ∈ {c A--c B}"
have "∃z ∈ d`{A..B}. infdist x (d`{A..B}) = dist x z"
apply (rule infdist_proper_attained[OF proper_of_compact], rule compact_continuous_image[OF ‹continuous_on {A..B} d›])
using that by auto
then obtain tx where "tx ∈ {A..B}" "infdist x (d`{A..B}) = dist x (d tx)" by blast
then have "dist x (d tx) ≤ D0"
using first_step[OF ‹x ∈ {c A--c B}›] by auto
then have "x ∈ cball (d tx) D0" by (auto simp add: metric_space_class.dist_commute)
consider "tx ∈ {A..tm}" | "tx ∈ {tm<..<tM}" | "tx ∈ {tM..B}"
using ‹tx ∈ {A..B}› by fastforce
then show "x ∈ Km ∪ KM"
proof (cases)
case 1
then have "x ∈ Km" unfolding Km_def using ‹x ∈ cball (d tx) D0› by auto
then show ?thesis by simp
next
case 3
then have "x ∈ KM" unfolding KM_def using ‹x ∈ cball (d tx) D0› by auto
then show ?thesis by simp
next
case 2
have "infdist (d tx) {c A--c B} ≤ dist (d tx) x" using ‹x ∈ {c A--c B}› by (rule infdist_le)
also have "... ≤ D0" using ‹x ∈ cball (d tx) D0› by auto
finally have False using lower_tm_tM[OF 2] by simp
then show ?thesis by simp
qed
qed
then have *: "{c A--c B} = (Km ∩ {c A--c B}) ∪ (KM ∩ {c A--c B})" by auto
have "(Km ∩ {c A--c B}) ∩ (KM ∩ {c A--c B}) ≠ {}"
proof (rule connected_as_closed_union[OF _ *])
have "closed Km"
unfolding Km_def apply (rule compact_has_closed_thickening)
apply (rule compact_continuous_image)
apply (rule continuous_on_subset[OF ‹continuous_on {A..B} d›])
using tm ‹ty ∈ {A..B}› by auto
then show "closed (Km ∩ {c A--c B})" by (rule topological_space_class.closed_Int, auto)
have "closed KM"
unfolding KM_def apply (rule compact_has_closed_thickening)
apply (rule compact_continuous_image)
apply (rule continuous_on_subset[OF ‹continuous_on {A..B} d›])
using tM ‹ty ∈ {A..B}› by auto
then show "closed (KM ∩ {c A--c B})" by (rule topological_space_class.closed_Int, auto)
show "connected {c A--c B}" by simp
have "c A ∈ Km ∩ {c A--c B}" apply auto
unfolding Km_def using tm ‹d A = c A› ‹D0 > 0› by (auto) (rule bexI[of _ A], auto)
then show "Km ∩ {c A--c B} ≠ {}" by auto
have "c B ∈ KM ∩ {c A--c B}" apply auto
unfolding KM_def using tM ‹d B = c B› ‹D0 > 0› by (auto) (rule bexI[of _ B], auto)
then show "KM ∩ {c A--c B} ≠ {}" by auto
qed
then obtain w where "w ∈ {c A--c B}" "w ∈ Km" "w ∈ KM" by auto
then obtain twm twM where tw: "twm ∈ {A..tm}" "w ∈ cball (d twm) D0" "twM ∈ {tM..B}" "w ∈ cball (d twM) D0"
unfolding Km_def KM_def by auto
have "(1/lambda) * dist twm twM - (4*C) ≤ dist (d twm) (d twM)"
apply (rule quasi_isometry_onD(2)[OF d(5)]) using tw tm tM by auto
also have "... ≤ dist (d twm) w + dist w (d twM)"
by (rule metric_space_class.dist_triangle)
also have "... ≤ 2 * D0" using tw by (auto simp add: metric_space_class.dist_commute)
finally have "dist twm twM ≤ lambda * (4*C + 2*D0)"
using C by (auto simp add: divide_simps algebra_simps)
then have *: "dist twm ty ≤ lambda * (4*C + 2*D0)"
using tw tm tM dist_real_def by auto
have "dist (d ty) w ≤ dist (d ty) (d twm) + dist (d twm) w"
by (rule metric_space_class.dist_triangle)
also have "... ≤ (lambda * dist ty twm + (4*C)) + D0"
apply (intro add_mono, rule quasi_isometry_onD(1)[OF d(5)]) using tw tm tM by auto
also have "... ≤ (lambda * (lambda * (4*C + 2*D0))) + (4*C) + D0"
apply (intro mono_intros) using C * by (auto simp add: metric_space_class.dist_commute)
also have "... = lambda * lambda * (4*C + 2*D0) + 1 * 1 * (4 * C) + 1 * 1 * D0"
by simp
also have "... ≤ lambda * lambda * (4*C + 2*D0) + lambda * lambda * (4 * C) + lambda * lambda * D0"
apply (intro mono_intros) using C * ‹D0 > 0› by auto
also have "... = lambda * lambda * (8 * C + 3 * D0)"
by (auto simp add: algebra_simps)
also have "... = lambda * lambda * (44 * C + 72 * lambda + 72 * deltaG(TYPE('a))^2)"
unfolding D0_def by auto
finally have "dist y w ≤ D1" unfolding D1_def ‹y = d ty› by (auto simp add: algebra_simps)
then show "infdist y {c A--c B} ≤ D1" using infdist_le[OF ‹w ∈ {c A--c B}›, of y] by auto
qed
text ‹This concludes the second step.›
text ‹Putting the two steps together, we deduce that the Hausdorff distance between the
geodesic and the quasi-geodesic is bounded by $D1$. A bound between the geodesic and
the original (untamed) quasi-geodesic follows.›
have a: "hausdorff_distance (d`{A..B}) {c A--c B} ≤ D1"
proof (rule hausdorff_distanceI)
show "D1 ≥ 0" unfolding D1_def using C delta_nonneg by auto
fix x assume "x ∈ d ` {A..B}"
then show "infdist x {c A--c B} ≤ D1" using second_step by auto
next
fix x assume "x ∈ {c A--c B}"
then show "infdist x (d`{A..B}) ≤ D1" using first_step ‹D0 ≤ D1› by force
qed
have "hausdorff_distance (c`{A..B}) {c A--c B} ≤
hausdorff_distance (c`{A..B}) (d`{A..B}) + hausdorff_distance (d`{A..B}) {c A--c B}"
apply (rule hausdorff_distance_triangle)
using ‹A ∈ {A..B}› apply blast
by (rule quasi_isometry_on_bounded[OF d(5)], auto)
also have "... ≤ D1 + 2*C" using a d by auto
also have "... = lambda * lambda * (72 * lambda + 44 * C + 72 * deltaG(TYPE('a))^2) + 1 * 1 * (2 * C)"
unfolding D1_def by auto
also have "... ≤ lambda * lambda * (72 * lambda + 44 * C + 72 * deltaG(TYPE('a))^2)
+ lambda * lambda * (28 * C)"
apply (intro mono_intros) using C delta_nonneg by auto
also have "... = 72 * lambda^2 * (lambda + C + deltaG(TYPE('a))^2)"
by (auto simp add: algebra_simps power2_eq_square)
finally show ?thesis by (auto simp add: algebra_simps)
qed
qed
end
Theory Bonk_Schramm_Extension
section ‹The Bonk Schramm extension›
theory Bonk_Schramm_Extension
imports Morse_Gromov_Theorem
begin
text ‹We want to show that any metric space is isometrically embedded in a
metric space which is geodesic (i.e., there is an embedded geodesic between any
two points) and complete. There are many such constructions, but a very interesting one
has been given by Bonk and Schramm in~\cite{bonk_schramm}, together with an additional property of the
completion: if the space is delta-hyperbolic (in the sense of Gromov), then its
completion also is, with the same constant delta. It follows in particular that a $0$-hyperbolic
space embeds in a $0$-hyperbolic geodesic space, i.e., a metric tree (there is an easier
direct construction in this case).
Another embedding of a metric space in a geodesic one is constructed by Mineyev~\cite{mineyev},
it is more canonical in a sense (isometries of the original space extend
to the new space), but it is not clear if it preserves hyperbolicity.
The argument of Bonk and Schramm goes as follows:
- first, if one wants to add the middle of a pair of points $a$ and $b$ in a space $E$, there is a
nice formula for the distance on a new space $E \cup \{*\}$ (where $*$ will by construction be a middle
of $a$ and $b$).
- by transfinite induction on all the pair of points in the space, one adds
all the missing middles
- then one completes the space
- then one adds all the middles
- then one goes on like that, transfinitely many times
- at some point, the process stops for cardinality reasons
The resulting space is complete and has middles for all pairs of points. It is then
standard that it is geodesic (this is proved in \verb+Geodesic_Spaces.thy+).
Implementing this construction in Isabelle is interesting and nontrivial,
as transfinite induction is not that easy, especially when intermingled with metric completion
(i.e., taking the quotient space of all Cauchy sequences). In particular, taking sequences of
metric completions would mean changing types at each step, along a transfinite number of steps.
It does not seem possible to do it naively in this way.
We avoid taking quotients in the middle of the argument, as this is too messy.
Instead, we define a pseudo-distance (i.e., a function satisyfing the
triangular inequality, but such that $d(x,y)$ can vanish even if $x$ and $y$ are different)
on an increasing set, which should contain middles and limits of Cauchy sequences
(identified with their defining Cauchy sequence). Thus, we consider a datatype containing
points in the original space and closed under two operations: taking a pair of points in the datatype
(we think of the resulting pair as the middle of the pair) and taking a sequence with
values in the datatype (we think of the resulting sequence as the limit of the sequence if
it is Cauchy, for a distance yet to be defined, and as something we discard if the sequence
is not Cauchy).
Defining such an object is apparently not trivial. However, it is
well defined, for cardinality reasons, as this process will end
after the continuum cardinality iterations (as a sequence taking value in the continuum
cardinality is in fact contained in a strictly smaller ordinal, which means that all
sequences in the construction will appear at a step strictly before the continuum cardinality).
The datatype construction in Isabelle/HOL contains these cardinality considerations
as an automatic process, and is thus able to construct the datatype directly,
without the need for any additional proof!
Then, we define a wellorder on the datatype, such that every middle and every sequence appear
after each of its ancestors. This construction of a wellorder should work for any datatype,
but we provide a naive proof in our use case.
Then, we define, inductively on $z$, a pseudodistance on the pair of points in
$\{x : x \leq z\}$. In the induction, one should add one point at a time. If it is
a middle, one uses the Bonk-Schramm recipe. If it is a sequence, then either the sequence
is Cauchy and one uses the limit of the distances to the points in the sequence,
or it is not Cauchy and one discards the new point by setting $d(a,a) = 1$.
(This means that, in the Bonk-Schramm recipe, we only use the points with $d(x,x) = 0$,
and show the triangular inequality there).
In the end, we obtain a space with a pseudodistance. The desired space is obtained
by quotienting out the space $\{x : d(x,x) = 0\}$ by the equivalence relation
given by $d(x,y) = 0$. The triangular inequality for the pseudo-distance shows
that it descends to a genuine distance on the quotient. This is the desired
geodesic complete extension of the original space.
›
subsection ‹Unfolded Bonk Schramm extension›
text ‹The unfolded Bonk Schramm extension, as explained at the beginning of this file, is a type made
of the initial type, adding all possible middles and all possible limits of Cauchy sequences,
without any quotienting process›
datatype 'a Bonk_Schramm_extension_unfolded =
basepoint 'a
| middle "'a Bonk_Schramm_extension_unfolded" "'a Bonk_Schramm_extension_unfolded"
| would_be_Cauchy "nat ⇒ 'a Bonk_Schramm_extension_unfolded"
context metric_space
begin
text ‹The construction of the distance will be done by transfinite induction,
with respect to a well-order for which the basepoints form an initial segment,
and for which middles of would-be Cauchy sequences are larger than the elements
they are made of. We will first prove the existence of such a well-order.
The idea is first to construct a function \verb+map_aux+ to another type, with a
well-order \verb+wo_aux+, such
that the image of \verb+middle a b+ is larger than the images of \verb+a+ and
\verb+b+ (take for instance the successor of the maximum of the two), and likewise
for a Cauchy sequence. A definition by induction works if the target cardinal is large
enough.
Then, pullback the well-order \verb+wo_aux+ by the map \verb+map_aux+: this gives a relation
that satisfies all the required properties, except that two different elements can be equal for
the order. Extending it essentially arbitrarily to distinguish between all elements (this is done
in Lemma \verb+Well_order_pullback+) gives the desired well-order›
definition Bonk_Schramm_extension_unfolded_wo where
"Bonk_Schramm_extension_unfolded_wo = (SOME (r::'a Bonk_Schramm_extension_unfolded rel).
well_order_on UNIV r
∧ (∀x ∈ range basepoint. ∀y ∈ - range basepoint. (x, y) ∈ r)
∧ (∀ a b. (a, middle a b) ∈ r)
∧ (∀ a b. (b, middle a b) ∈ r)
∧ (∀ u n. (u n, would_be_Cauchy u) ∈ r))"
text ‹We prove the existence of the well order›
definition wo_aux where
"wo_aux = (SOME (r:: (nat + 'a Bonk_Schramm_extension_unfolded set) rel).
Card_order r ∧ ¬finite(Field r) ∧ regularCard r ∧ |UNIV::'a Bonk_Schramm_extension_unfolded set| <o r)"
lemma wo_aux_exists:
"Card_order wo_aux ∧ ¬finite (Field wo_aux) ∧ regularCard wo_aux ∧ |UNIV::'a Bonk_Schramm_extension_unfolded set| <o wo_aux"
proof -
have *: "∀r ∈ {|UNIV::'a Bonk_Schramm_extension_unfolded set|}. Card_order r" by auto
have **: "∃(r::(nat + 'a Bonk_Schramm_extension_unfolded set) rel).
Card_order r ∧ ¬finite(Field r) ∧ regularCard r ∧ ( |UNIV::'a Bonk_Schramm_extension_unfolded set| <o r)"
by (metis card_of_card_order_on Field_card_of singletonI infinite_regularCard_exists[OF *])
then show ?thesis unfolding wo_aux_def using someI_ex[OF **] by auto
qed
interpretation wo_aux: wo_rel wo_aux
using wo_aux_exists Card_order_wo_rel by auto
primrec map_aux::"'a Bonk_Schramm_extension_unfolded ⇒ nat + 'a Bonk_Schramm_extension_unfolded set" where
"map_aux (basepoint x) = wo_aux.zero"
| "map_aux (middle a b) = wo_aux.suc ({map_aux a} ∪ {map_aux b})"
| "map_aux (would_be_Cauchy u) = wo_aux.suc ((map_aux o u)`UNIV)"
lemma map_aux_AboveS_not_empty:
assumes "map_aux`S ⊆ Field wo_aux"
shows "wo_aux.AboveS (map_aux`S) ≠ {}"
apply (rule AboveS_not_empty_in_regularCard'[of S])
using wo_aux_exists assms apply auto
using card_of_UNIV ordLeq_ordLess_trans by blast
lemma map_aux_in_Field:
"map_aux x ∈ Field wo_aux"
proof (induction)
case (basepoint x)
have "wo_aux.zero ∈ Field wo_aux"
using Card_order_infinite_not_under wo_aux_exists under_empty wo_aux.zero_in_Field by fastforce
then show ?case by auto
next
case mid: (middle a b)
have "({map_aux a} ∪ {map_aux b}) ⊆ Field wo_aux" using mid.IH by auto
then have "wo_aux.AboveS ({map_aux a} ∪ {map_aux b}) ≠ {}"
using map_aux_AboveS_not_empty[of "{a} ∪ {b}"] by auto
then show ?case
by (simp add: AboveS_Field wo_aux.suc_def)
next
case cauchy: (would_be_Cauchy u)
have "(map_aux o u)`UNIV ⊆ Field wo_aux" using cauchy.IH by auto
then have "wo_aux.AboveS ((map_aux o u)`UNIV) ≠ {}"
using map_aux_AboveS_not_empty[of "u`(UNIV)"] by (simp add: image_image)
then show ?case
by (simp add: AboveS_Field wo_aux.suc_def)
qed
lemma middle_rel_a:
"(map_aux a, map_aux (middle a b)) ∈ wo_aux - Id"
proof -
have *: "({map_aux a} ∪ {map_aux b}) ⊆ Field wo_aux" using map_aux_in_Field by auto
then have "wo_aux.AboveS ({map_aux a} ∪ {map_aux b}) ≠ {}"
using map_aux_AboveS_not_empty[of "{a} ∪ {b}"] by auto
then show ?thesis
using * by (simp add: wo_aux.suc_greater Id_def)
qed
lemma middle_rel_b:
"(map_aux b, map_aux (middle a b)) ∈ wo_aux - Id"
proof -
have *: "({map_aux a} ∪ {map_aux b}) ⊆ Field wo_aux" using map_aux_in_Field by auto
then have "wo_aux.AboveS ({map_aux a} ∪ {map_aux b}) ≠ {}"
using map_aux_AboveS_not_empty[of "{a} ∪ {b}"] by auto
then show ?thesis
using * by (simp add: wo_aux.suc_greater Id_def)
qed
lemma cauchy_rel:
"(map_aux (u n), map_aux (would_be_Cauchy u)) ∈ wo_aux - Id"
proof -
have *: "(map_aux o u)`UNIV ⊆ Field wo_aux" using map_aux_in_Field by auto
then have "wo_aux.AboveS ((map_aux o u)`UNIV) ≠ {}"
using map_aux_AboveS_not_empty[of "u`(UNIV)"] by (simp add: image_image)
then show ?thesis
using * by (simp add: wo_aux.suc_greater Id_def)
qed
text ‹From the above properties of \verb+wo_aux+, it follows using \verb+Well_order_pullback+
that an order satisfying all the properties we want of \verb+Bonk_Schramm_extension_unfolded_wo+
exists. Hence, we get the following lemma.›
lemma Bonk_Schramm_extension_unfolded_wo_props:
"well_order_on UNIV Bonk_Schramm_extension_unfolded_wo"
"∀x ∈ range basepoint. ∀y ∈ - range basepoint. (x, y) ∈ Bonk_Schramm_extension_unfolded_wo"
"∀ a b. (a, middle a b) ∈ Bonk_Schramm_extension_unfolded_wo"
"∀ a b. (b, middle a b) ∈ Bonk_Schramm_extension_unfolded_wo"
"∀u n. (u n, would_be_Cauchy u) ∈ Bonk_Schramm_extension_unfolded_wo"
proof -
obtain r::"'a Bonk_Schramm_extension_unfolded rel" where r:
"Well_order r"
"Field r = UNIV"
"⋀x y. (map_aux x, map_aux y) ∈ wo_aux - Id ⟹ (x, y) ∈ r"
using Well_order_pullback[of wo_aux map_aux] by (metis wo_aux.WELL)
have "(x, y) ∈ r" if "x ∈ range basepoint" "y ∈ - range basepoint" for x y
apply (rule r(3)) using that
apply (cases y)
apply (auto cong del: image_cong_simp)
apply (metis insert_is_Un map_aux.simps(2) map_aux_in_Field wo_aux.zero_smallest)
apply (metis Diff_iff insert_is_Un wo_aux.leq_zero_imp map_aux.simps(2) middle_rel_a pair_in_Id_conv)
apply (metis map_aux.simps(3) map_aux_in_Field wo_aux.zero_smallest)
apply (metis Diff_iff cauchy_rel wo_aux.leq_zero_imp map_aux.simps(3) pair_in_Id_conv)
done
moreover have "(a, middle a b) ∈ r" for a b
apply (rule r(3)) using middle_rel_a by auto
moreover have "(b, middle a b) ∈ r" for a b
apply (rule r(3)) using middle_rel_b by auto
moreover have "(u n, would_be_Cauchy u) ∈ r" for u n
apply (rule r(3)) using cauchy_rel by auto
moreover have "well_order_on UNIV r"
using r(1) r(2) by auto
ultimately have *: "∃ (r::'a Bonk_Schramm_extension_unfolded rel).
well_order_on UNIV r
∧ (∀x ∈ range basepoint. ∀y ∈ - range basepoint. (x, y) ∈ r)
∧ (∀ a b. (a, middle a b) ∈ r)
∧ (∀ a b. (b, middle a b) ∈ r)
∧ (∀u n. (u n, would_be_Cauchy u) ∈ r)"
by blast
show
"well_order_on UNIV Bonk_Schramm_extension_unfolded_wo"
"∀x ∈ range basepoint. ∀y ∈ - range basepoint. (x, y) ∈ Bonk_Schramm_extension_unfolded_wo"
"∀ a b. (a, middle a b) ∈ Bonk_Schramm_extension_unfolded_wo"
"∀ a b. (b, middle a b) ∈ Bonk_Schramm_extension_unfolded_wo"
"∀u n. (u n, would_be_Cauchy u) ∈ Bonk_Schramm_extension_unfolded_wo"
unfolding Bonk_Schramm_extension_unfolded_wo_def using someI_ex[OF *] by auto
qed
interpretation wo: wo_rel Bonk_Schramm_extension_unfolded_wo
using well_order_on_Well_order wo_rel_def wfrec_def Bonk_Schramm_extension_unfolded_wo_props(1) by blast
text ‹We reformulate in the interpretation \verb+wo+ the main properties of
\verb+Bonk_Schramm_extension_unfolded_wo+ that we established in Lemma~\verb+Bonk_Schramm_extension_unfolded_wo_props+›
lemma Bonk_Schramm_extension_unfolded_wo_props':
"a ∈ wo.underS (middle a b)"
"b ∈ wo.underS (middle a b)"
"u n ∈ wo.underS (would_be_Cauchy u)"
proof -
have "(a, middle a b) ∈ Bonk_Schramm_extension_unfolded_wo"
using Bonk_Schramm_extension_unfolded_wo_props(3) by auto
then show "a ∈ wo.underS (middle a b)"
by (metis Diff_iff middle_rel_a pair_in_Id_conv underS_I)
have "(b, middle a b) ∈ Bonk_Schramm_extension_unfolded_wo"
using Bonk_Schramm_extension_unfolded_wo_props(4) by auto
then show "b ∈ wo.underS (middle a b)"
by (metis Diff_iff middle_rel_b pair_in_Id_conv underS_I)
have "(u n, would_be_Cauchy u) ∈ Bonk_Schramm_extension_unfolded_wo"
using Bonk_Schramm_extension_unfolded_wo_props(5) by auto
then show "u n ∈ wo.underS (would_be_Cauchy u)"
by (metis Diff_iff cauchy_rel pair_in_Id_conv underS_I)
qed
text ‹We want to define by transfinite induction a distance on \verb+'a Bonk_Schramm_extension_unfolded+,
adding one point at a time (i.e., if the distance is defined on $E$, then one wants to define it
on $E \cup \{x\}$, if $x$ is a middle or a potential Cauchy sequence, by prescribing the distance
from $x$ to all the points in $E$.
Technically, we define a family of distances, indexed by $x$, on $\{y : y \leq x\}^2$. As all
functions should be defined everywhere, this will be a family of functions on $X \times X$, indexed
by points in $X$. They will have a compatibility condition, making it possible to define a global
distance by gluing them together.
Technically, transfinite induction is implemented in Isabelle/HOL by an updating rule: a function
that associates, to a family of distances indexed by $x$, a new family of distances indexed by $x$.
The result of the transfinite induction is obtained by starting from an arbitrary object, and then
applying the updating rule infinitely many times. The characteristic property of the result of this
transfinite induction is that it is a fixed point of the updating rule, as it should.
Below, this is implemented as follows:
\begin{itemize}
\item \verb+extend_distance+ is the updating rule.
\item Its fixed point \verb+extend_distance_fp+ is by definition \verb+wo.worec extend_distance+
(it only makes sense if the udpating rule satisfies a compatibility condition
\verb+wo.adm_wo extend_distance+ saying that the update of a family, at $x$,
only depends on the value of the family
strictly below $x$.
\item Finally, the global distance \verb+extended_distance+ is taken as the
value of the fixed point above, on $x y y'$ (i.e., using the distance indexed by $x$) for any $x
\geq \max(y, y')$. For definiteness, we use $\max(y, y')$, but it does not matter as everything is
compatible.
\end{itemize}›
fun extend_distance::"('a Bonk_Schramm_extension_unfolded ⇒ ('a Bonk_Schramm_extension_unfolded ⇒ 'a Bonk_Schramm_extension_unfolded ⇒ real))
⇒ ('a Bonk_Schramm_extension_unfolded ⇒ ('a Bonk_Schramm_extension_unfolded ⇒ 'a Bonk_Schramm_extension_unfolded ⇒ real))"
where
"extend_distance f (basepoint x) = (λy z. if y ∈ range basepoint ∧ z ∈ range basepoint then
dist (SOME y'. y = basepoint y') (SOME z'. z = basepoint z') else 1)"
| "extend_distance f (middle a b) = (λy z.
if (y ∈ wo.underS (middle a b)) ∧ (z ∈ wo.underS (middle a b)) then f (wo.max2 y z) y z
else if (y ∈ wo.underS (middle a b)) ∧ (z = middle a b) then (f (wo.max2 a b) a b)/2 + (SUP w∈{z ∈ wo.underS (middle a b). f z z z = 0}. f (wo.max2 y w) y w - max (f (wo.max2 a w) a w) (f (wo.max2 b w) b w))
else if (y = middle a b) ∧ (z ∈ wo.underS (middle a b)) then (f (wo.max2 a b) a b)/2 + (SUP w∈{z ∈ wo.underS (middle a b). f z z z = 0}. f (wo.max2 z w) z w - max (f (wo.max2 a w) a w) (f (wo.max2 b w) b w))
else if (y = middle a b) ∧ (z = middle a b) ∧ (f a a a = 0) ∧ (f b b b = 0) then 0
else 1)"
| "extend_distance f (would_be_Cauchy u) = (λy z.
if (y ∈ wo.underS (would_be_Cauchy u)) ∧ (z ∈ wo.underS (would_be_Cauchy u)) then f (wo.max2 y z) y z
else if (¬(∀eps > (0::real). ∃N. ∀n ≥ N. ∀m ≥ N. f (wo.max2 (u n) (u m)) (u n) (u m) < eps)) then 1
else if (y ∈ wo.underS (would_be_Cauchy u)) ∧ (z = would_be_Cauchy u) then lim (λn. f (wo.max2 (u n) y) (u n) y)
else if (y = would_be_Cauchy u) ∧ (z ∈ wo.underS (would_be_Cauchy u)) then lim (λn. f (wo.max2 (u n) z) (u n) z)
else if (y = would_be_Cauchy u) ∧ (z = would_be_Cauchy u) ∧ (∀n. f (u n) (u n) (u n) = 0) then 0
else 1)"
definition "extend_distance_fp = wo.worec extend_distance"
definition "extended_distance x y = extend_distance_fp (wo.max2 x y) x y"
definition "extended_distance_set = {z. extended_distance z z = 0}"
lemma wo_adm_extend_distance:
"wo.adm_wo extend_distance"
unfolding wo.adm_wo_def proof (auto)
fix f g::"'a Bonk_Schramm_extension_unfolded ⇒ 'a Bonk_Schramm_extension_unfolded ⇒ 'a Bonk_Schramm_extension_unfolded ⇒ real"
fix x::"'a Bonk_Schramm_extension_unfolded"
assume "∀y∈wo.underS x. f y = g y"
then have *: "f y = g y" if "y ∈ wo.underS x" for y using that by auto
show "extend_distance f x = extend_distance g x"
apply (cases x)
apply (insert Bonk_Schramm_extension_unfolded_wo_props' *)
apply auto
apply (rule ext)+
apply (rule if_cong, simp, simp)+ apply (rule SUP_cong, fastforce, blast)
apply (rule if_cong, simp, simp)+ apply (rule SUP_cong, fastforce, blast)
apply (rule if_cong, simp, simp)+ apply simp
apply (rule ext)+
apply (rule if_cong, simp, simp)+
apply simp
done
qed
lemma extend_distance_fp:
"extend_distance_fp = extend_distance (extend_distance_fp)"
using wo.worec_fixpoint[OF wo_adm_extend_distance] unfolding extend_distance_fp_def.
lemma extended_distance_symmetric:
"extended_distance x y = extended_distance y x"
proof -
have *: "extend_distance (extend_distance_fp) x x y = extend_distance (extend_distance_fp) x y x" if "y ∈ wo.underS x" for x y
apply (cases x)
apply (simp add: that dist_commute)+
by blast
have **: "extended_distance x y = extended_distance y x" if "y ∈ wo.underS x" for x y
unfolding extended_distance_def using that *[OF that] extend_distance_fp by simp
consider "y ∈ wo.underS x"|"x ∈ wo.underS y"|"x = y"
by (metis UNIV_I Bonk_Schramm_extension_unfolded_wo_props(1) that(1) underS_I well_order_on_Well_order wo.TOTALS)
then show ?thesis
apply (cases) using ** by auto
qed
lemma extended_distance_basepoint:
"extended_distance (basepoint x) (basepoint y) = dist x y"
proof -
consider "wo.max2 (basepoint x) (basepoint y) = basepoint x" | "wo.max2 (basepoint x) (basepoint y) = basepoint y"
by (meson wo.max2_def)
then show ?thesis
apply cases
unfolding extended_distance_def by (subst extend_distance_fp, simp)+
qed
lemma extended_distance_set_basepoint:
"basepoint x ∈ extended_distance_set"
unfolding extended_distance_set_def using extended_distance_basepoint by auto
lemma extended_distance_set_middle:
assumes "a ∈ extended_distance_set" "b ∈ extended_distance_set"
shows "middle a b ∈ extended_distance_set"
using assms unfolding extended_distance_set_def extended_distance_def apply auto
by (metis (no_types, lifting) extend_distance_fp extend_distance.simps(2) underS_E)
lemma extended_distance_set_middle':
assumes "middle a b ∈ extended_distance_set"
shows "a ∈ extended_distance_set ∩ wo.underS (middle a b)"
"b ∈ extended_distance_set ∩ wo.underS (middle a b)"
proof -
have "extend_distance (extend_distance_fp) (middle a b) (middle a b) (middle a b) = 0"
apply (subst extend_distance_fp[symmetric])
using assms unfolding extended_distance_set_def extended_distance_def by simp
then have "a ∈ extended_distance_set" "b ∈ extended_distance_set"
unfolding extended_distance_set_def extended_distance_def apply auto
by (metis zero_neq_one)+
moreover have "a ∈ wo.underS (middle a b)" "b ∈ wo.underS (middle a b)"
by (auto simp add: Bonk_Schramm_extension_unfolded_wo_props')
ultimately show "a ∈ extended_distance_set ∩ wo.underS (middle a b)"
"b ∈ extended_distance_set ∩ wo.underS (middle a b)"
by auto
qed
lemma extended_distance_middle_formula:
assumes "x ∈ wo.underS (middle a b)"
shows "extended_distance x (middle a b) = (extended_distance a b)/2
+ (SUP w∈wo.underS (middle a b) ∩ extended_distance_set.
extended_distance x w - max (extended_distance a w) (extended_distance b w))"
unfolding extended_distance_set_def extended_distance_def
apply (subst extend_distance_fp)
apply (simp add: assms)
apply (rule SUP_cong)
apply (auto simp add: wo.max2_def)
done
lemma extended_distance_set_Cauchy:
assumes "(would_be_Cauchy u) ∈ extended_distance_set"
shows "u n ∈ extended_distance_set ∩ wo.underS (would_be_Cauchy u)"
"∀eps > (0::real). ∃N. ∀n ≥ N. ∀m ≥ N. extended_distance (u n) (u m) < eps"
proof -
have *: "extend_distance (extend_distance_fp) (would_be_Cauchy u) (would_be_Cauchy u) (would_be_Cauchy u) = 0"
apply (subst extend_distance_fp[symmetric])
using assms unfolding extended_distance_set_def extended_distance_def by simp
then have "u n ∈ extended_distance_set"
unfolding extended_distance_set_def extended_distance_def apply auto
by (metis (no_types, hide_lams) underS_notIn zero_neq_one)
moreover have "u n ∈ wo.underS (would_be_Cauchy u)"
by (auto simp add: Bonk_Schramm_extension_unfolded_wo_props')
ultimately show "u n ∈ extended_distance_set ∩ wo.underS (would_be_Cauchy u)"
by auto
show "∀eps > (0::real). ∃N. ∀n ≥ N. ∀m ≥ N. extended_distance (u n) (u m) < eps"
using * unfolding extended_distance_set_def extended_distance_def apply auto
by (metis (no_types, hide_lams) zero_neq_one)
qed
lemma extended_distance_triang_ineq:
assumes "x ∈ extended_distance_set"
"y ∈ extended_distance_set"
"z ∈ extended_distance_set"
shows "extended_distance x z ≤ extended_distance x y + extended_distance y z"
proof -
have ineq_rec: "∀x y z. x ∈ wo.under t ∩ extended_distance_set ⟶ y ∈ wo.under t ∩ extended_distance_set ⟶ z ∈ wo.under t ∩ extended_distance_set
⟶ extended_distance x z ≤ extended_distance x y + extended_distance y z" for t
proof (rule wo.well_order_induct[of _ t])
fix t
assume IH_orig: "∀t2. t2 ≠ t ∧ (t2, t) ∈ Bonk_Schramm_extension_unfolded_wo ⟶
(∀x y z. x ∈ wo.under t2 ∩ extended_distance_set ⟶
y ∈ wo.under t2 ∩ extended_distance_set ⟶
z ∈ wo.under t2 ∩ extended_distance_set ⟶
extended_distance x z ≤ extended_distance x y + extended_distance y z)"
then have IH: "extended_distance x z ≤ extended_distance x y + extended_distance y z"
if "x ∈ wo.underS t ∩ extended_distance_set"
"y ∈ wo.underS t ∩ extended_distance_set"
"z ∈ wo.underS t ∩ extended_distance_set"
for x y z
proof -
define t2 where "t2 = wo.max2 (wo.max2 x y) z"
have "t2 ∈ wo.underS t" using that t2_def by auto
have "x ∈ wo.under t2" "y ∈ wo.under t2" "z ∈ wo.under t2" unfolding t2_def
by (metis UNIV_I Bonk_Schramm_extension_unfolded_wo_props(1) mem_Collect_eq under_def well_order_on_Well_order wo.TOTALS wo.max2_iff)+
then show ?thesis using that IH_orig ‹t2 ∈ wo.underS t› underS_E by fastforce
qed
have pos: "extended_distance x y ≥ 0" if "x ∈ wo.underS t ∩ extended_distance_set" "y ∈ wo.underS t ∩ extended_distance_set" for x y
proof -
have "0 = extended_distance x x" using that(1) extended_distance_set_def by auto
also have "... ≤ extended_distance x y + extended_distance y x"
using IH that by auto
also have "... = 2 * extended_distance x y"
using extended_distance_symmetric by auto
finally show ?thesis by auto
qed
consider "t ∉ extended_distance_set" | "t ∈ extended_distance_set" by auto
then show "∀x y z. x ∈ wo.under t ∩ extended_distance_set ⟶
y ∈ wo.under t ∩ extended_distance_set ⟶
z ∈ wo.under t ∩ extended_distance_set ⟶
extended_distance x z ≤ extended_distance x y + extended_distance y z"
proof (cases)
case 1
then have "wo.under t ∩ extended_distance_set = wo.underS t ∩ extended_distance_set"
apply auto
apply (metis mem_Collect_eq underS_I under_def)
by (simp add: underS_E under_def)
then show ?thesis using IH by auto
next
case 2
have main_ineq: "extended_distance x z ≤ extended_distance x t + extended_distance t z
∧ extended_distance x t ≤ extended_distance x z + extended_distance z t"
if "x ∈ wo.underS t ∩ extended_distance_set"
"z ∈ wo.underS t ∩ extended_distance_set"
for x z
proof (cases t)
case A: (basepoint t')
then have "x ∈ range basepoint" using Bonk_Schramm_extension_unfolded_wo_props(2)
by (metis that(1) Compl_iff Int_iff range_eqI wo.max2_def wo.max2_underS'(2))
then obtain x' where x: "x = basepoint x'" by auto
have "z ∈ range basepoint" using Bonk_Schramm_extension_unfolded_wo_props(2) A
by (metis that(2) Compl_iff Int_iff range_eqI wo.max2_def wo.max2_underS'(2))
then obtain z' where z: "z = basepoint z'" by auto
show "extended_distance x z ≤ extended_distance x t + extended_distance t z
∧ extended_distance x t ≤ extended_distance x z + extended_distance z t"
unfolding x z A extended_distance_basepoint by (simp add: dist_triangle)
next
case M: (middle a b)
then have ab: "a ∈ extended_distance_set ∩ wo.underS (middle a b)"
"b ∈ extended_distance_set ∩ wo.underS (middle a b)"
using 2 extended_distance_set_middle'[of a b] by auto
have dxt: "extended_distance x t = (extended_distance a b)/2
+ (SUP w∈wo.underS (middle a b) ∩ extended_distance_set.
extended_distance x w - max (extended_distance a w) (extended_distance b w))"
using that(1) unfolding M using extended_distance_middle_formula by auto
have dzt: "extended_distance z t = (extended_distance a b)/2
+ (SUP w∈wo.underS (middle a b) ∩ extended_distance_set.
extended_distance z w - max (extended_distance a w) (extended_distance b w))"
using that(2) unfolding M using extended_distance_middle_formula by auto
have bdd: "bdd_above ((λw. extended_distance x w - max (extended_distance a w) (extended_distance b w))` (wo.underS (middle a b) ∩ extended_distance_set))"
if "x ∈ wo.underS t ∩ extended_distance_set" for x
proof (rule bdd_aboveI2)
fix w assume w: "w ∈ wo.underS (middle a b) ∩ extended_distance_set"
have "extended_distance x w ≤ extended_distance x a + extended_distance a w"
apply (rule IH) using ab w M that(1) by auto
also have "... ≤ extended_distance x a + max (extended_distance a w) (extended_distance b w)"
by auto
finally show "extended_distance x w - max (extended_distance a w) (extended_distance b w)
≤ extended_distance x a"
by auto
qed
have "(λw. extended_distance x z + extended_distance z w - max (extended_distance a w) (extended_distance b w)) ` (underS Bonk_Schramm_extension_unfolded_wo (middle a b) ∩ extended_distance_set)
= (λs. s + extended_distance x z)` (λw. extended_distance z w - max (extended_distance a w) (extended_distance b w)) ` (underS Bonk_Schramm_extension_unfolded_wo (middle a b) ∩ extended_distance_set)"
by auto
moreover have "bdd_above ((λs. s + extended_distance x z)` (λw. extended_distance z w - max (extended_distance a w) (extended_distance b w)) ` (underS Bonk_Schramm_extension_unfolded_wo (middle a b) ∩ extended_distance_set))"
apply (rule bdd_above_image_mono) using bdd that by (auto simp add: mono_def)
ultimately have bdd_3: "bdd_above ((λw. extended_distance x z + extended_distance z w - max (extended_distance a w) (extended_distance b w)) ` (underS Bonk_Schramm_extension_unfolded_wo (middle a b) ∩ extended_distance_set))"
by simp
have **: "max (extended_distance a a) (extended_distance b a) = extended_distance b a"
apply (rule max_absorb2) using pos ab extended_distance_set_def M by auto
then have "-extended_distance a b / 2 + extended_distance x a
= (extended_distance a b)/2 + extended_distance x a - max (extended_distance a a) (extended_distance b a)"
unfolding extended_distance_symmetric[of a b] by auto
also have "... ≤ extended_distance x t"
unfolding dxt apply (simp, rule cSUP_upper, simp) using bdd that M ab by auto
finally have D1: "-extended_distance a b / 2 + extended_distance x a ≤ extended_distance x t"
by simp
have **: "max (extended_distance a b) (extended_distance b b) = extended_distance a b"
apply (rule max_absorb1) using pos ab extended_distance_set_def M by auto
then have "-extended_distance a b / 2 + extended_distance x b
= (extended_distance a b)/2 + extended_distance x b - max (extended_distance a b) (extended_distance b b)"
unfolding extended_distance_symmetric[of a b] by auto
also have "... ≤ extended_distance x t"
unfolding dxt apply (simp, rule cSUP_upper, simp) using bdd that ab by auto
finally have "-extended_distance a b / 2 + extended_distance x b ≤ extended_distance x t"
by simp
then have D2: "-extended_distance a b / 2 + max (extended_distance x a) (extended_distance x b) ≤ extended_distance x t"
using D1 by auto
have "extended_distance x z = (-extended_distance a b / 2 + max (extended_distance x a) (extended_distance x b)) +
(extended_distance a b / 2 + extended_distance x z - max (extended_distance x a) (extended_distance x b))"
by auto
also have "... ≤ extended_distance x t +
(extended_distance a b / 2 + extended_distance z x - max (extended_distance a x) (extended_distance b x))"
using D2 extended_distance_symmetric by auto
also have "... ≤ extended_distance x t + extended_distance z t"
unfolding dzt apply (simp, rule cSUP_upper) using bdd that M ab by auto
finally have I: "extended_distance x z ≤ extended_distance x t + extended_distance z t"
using extended_distance_symmetric by auto
have T: "underS Bonk_Schramm_extension_unfolded_wo (middle a b) ∩ extended_distance_set ≠ {}"
"mono ((+) (extended_distance x z))"
"bij ((+) (extended_distance x z))"
using ab(1) apply blast
by (simp add: monoI, rule bij_betw_byWitness[of _ "λs. s - (extended_distance x z)"], auto)
have "extended_distance x t ≤ (extended_distance a b)/2
+ (SUP w∈wo.underS (middle a b) ∩ extended_distance_set.
extended_distance x z + extended_distance z w - max (extended_distance a w) (extended_distance b w))"
unfolding dxt apply (simp, rule cSUP_subset_mono)
using M that IH bdd_3 by (auto)
also have "... = extended_distance x z + extended_distance z t"
unfolding dzt apply simp
using mono_cSup_bij[of "(λw. extended_distance z w - max (extended_distance a w) (extended_distance b w))`(wo.underS (middle a b) ∩ extended_distance_set)" "λs. extended_distance x z + s", OF _ _ T(2) T(3)]
by (auto simp add: bdd [OF that(2)] ab(1) T(1) add_diff_eq image_comp)
finally have "extended_distance x t ≤ extended_distance x z + extended_distance z t" by simp
then show "extended_distance x z ≤ extended_distance x t + extended_distance t z
∧ extended_distance x t ≤ extended_distance x z + extended_distance z t"
using I extended_distance_symmetric by auto
next
case C: (would_be_Cauchy u)
then have un: "u n ∈ extended_distance_set ∩ wo.underS (would_be_Cauchy u)" for n
using extended_distance_set_Cauchy 2 by auto
have lim: "(λn. extended_distance y (u n)) ⇢ (extended_distance y (would_be_Cauchy u))"
if y: "y ∈ extended_distance_set ∩ wo.underS (would_be_Cauchy u)" for y
proof -
have "extend_distance extend_distance_fp (wo.max2 (would_be_Cauchy u) (would_be_Cauchy u)) (would_be_Cauchy u) (would_be_Cauchy u) = 0"
using 2 unfolding C extended_distance_set_def extended_distance_def
using extend_distance_fp by auto
then have cauch: "∃N. ∀n ≥ N. ∀m ≥ N. extend_distance_fp (wo.max2 (u n) (u m)) (u n) (u m) < e" if "e > 0" for e
apply auto using ‹e > 0› by (metis (no_types, hide_lams) zero_neq_one)
have "∃N. ∀n ≥ N. ∀m ≥ N. abs(extended_distance y (u n) - extended_distance y (u m)) < e" if "e > 0" for e
proof -
obtain N where *: "extend_distance_fp (wo.max2 (u n) (u m)) (u n) (u m) < e" if "n ≥ N" "m ≥ N" for m n
using cauch by (meson ‹0 < e›)
{
fix m n assume "m ≥ N" "n ≥ N"
then have e: "extended_distance (u n) (u m) < e" using * unfolding extended_distance_def by auto
have "extended_distance y (u n) ≤ extended_distance y (u m) + extended_distance (u m) (u n)"
using IH y un C by blast
then have 1: "extended_distance y (u n) - extended_distance y (u m) < e"
using e extended_distance_symmetric by auto
have "extended_distance y (u m) ≤ extended_distance y (u n) + extended_distance (u n) (u m)"
using IH y un C by blast
then have "extended_distance y (u m) - extended_distance y (u n) < e"
using e extended_distance_symmetric by auto
then have "abs(extended_distance y (u n) - extended_distance y (u m)) < e"
using 1 by auto
}
then show ?thesis by auto
qed
then have "convergent (λn. extended_distance y (u n))"
by (simp add: Cauchy_iff real_Cauchy_convergent)
then have lim: "(λn. extended_distance y (u n)) ⇢ lim (λn. extended_distance y (u n))"
using convergent_LIMSEQ_iff by auto
have *: "wo.max2 y (would_be_Cauchy u) = would_be_Cauchy u" "y ≠ would_be_Cauchy u" using y by auto
have "extended_distance y (would_be_Cauchy u) = lim (λn. extended_distance (u n) y)"
unfolding extended_distance_def apply (subst extend_distance_fp) unfolding *
using *(2) y cauch by auto
then show "(λn. extended_distance y (u n)) ⇢ extended_distance y (would_be_Cauchy u)"
using lim extended_distance_symmetric by auto
qed
have "extended_distance x z ≤ extended_distance x (u n) + extended_distance (u n) z" for n
using IH un that C by auto
moreover have "(λn. extended_distance x (u n) + extended_distance (u n) z) ⇢ extended_distance x t + extended_distance t z"
apply (auto intro!: tendsto_add)
using lim that extended_distance_symmetric unfolding C by auto
ultimately have I: "extended_distance x z ≤ extended_distance x t + extended_distance t z"
using LIMSEQ_le_const by blast
have "extended_distance x (u n) ≤ extended_distance x z + extended_distance z (u n)" for n
using IH un that C by auto
moreover have "(λn. extended_distance x (u n)) ⇢ extended_distance x t"
using lim that extended_distance_symmetric unfolding C by auto
moreover have "(λn. extended_distance x z + extended_distance z (u n)) ⇢ extended_distance x z + extended_distance z t"
apply (auto intro!: tendsto_add)
using lim that extended_distance_symmetric unfolding C by auto
ultimately have "extended_distance x t ≤ extended_distance x z + extended_distance z t"
using LIMSEQ_le by blast
then show "extended_distance x z ≤ extended_distance x t + extended_distance t z
∧ extended_distance x t ≤ extended_distance x z + extended_distance z t"
using I by auto
qed
{
fix x y z assume H: "x ∈ wo.under t ∩ extended_distance_set"
"y ∈ wo.under t ∩ extended_distance_set"
"z ∈ wo.under t ∩ extended_distance_set"
have t: "extended_distance t t = 0" "extended_distance t t ≥ 0" using 2 extended_distance_set_def by auto
have *: "((x ∈ wo.underS t ∩ extended_distance_set) ∨ (x = t))
∧ ((y ∈ wo.underS t ∩ extended_distance_set) ∨ (y = t))
∧ ((z ∈ wo.underS t ∩ extended_distance_set) ∨ (z = t))"
using H by (simp add: underS_def under_def)
have "extended_distance x z ≤ extended_distance x y + extended_distance y z"
using * apply auto
using t main_ineq extended_distance_symmetric IH pos apply blast
using t main_ineq extended_distance_symmetric IH pos apply blast
using t main_ineq extended_distance_symmetric IH pos apply blast
using t main_ineq extended_distance_symmetric IH pos apply blast
using t main_ineq extended_distance_symmetric IH pos apply (metis * Int_commute add.commute underS_notIn)
using t main_ineq extended_distance_symmetric IH pos apply (metis (mono_tags, lifting) "*" extended_distance_set_def mem_Collect_eq underS_notIn)
using t by auto
}
then show ?thesis by auto
qed
qed
define t where "t = wo.max2 (wo.max2 x y) z"
have "x ∈ wo.under t" "y ∈ wo.under t" "z ∈ wo.under t"
unfolding t_def
by (metis UNIV_I Bonk_Schramm_extension_unfolded_wo_props(1) mem_Collect_eq under_def well_order_on_Well_order wo.max2_equals1 wo.max2_iff wo.max2_xx)+
then show ?thesis using assms ineq_rec by auto
qed
text ‹We can now show the two main properties of the construction: the middle is indeed a middle
from the metric point of view (in \verb+extended_distance_middle+), and Cauchy sequences have
a limit (the corresponding \verb+would_be_Cauchy+ point).›
lemma extended_distance_pos:
assumes "a ∈ extended_distance_set"
"b ∈ extended_distance_set"
shows "extended_distance a b ≥ 0"
using assms extended_distance_set_def extended_distance_triang_ineq[of a b a]
unfolding extended_distance_symmetric[of b a] by auto
lemma extended_distance_middle:
assumes "a ∈ extended_distance_set"
"b ∈ extended_distance_set"
shows "extended_distance a (middle a b) = extended_distance a b / 2"
"extended_distance b (middle a b) = extended_distance a b / 2"
proof -
have "0 = extended_distance a b - max (extended_distance a b) (extended_distance b b)"
using extended_distance_pos[OF assms] assms(2) extended_distance_set_def by auto
also have "... ≤ (SUP w∈wo.underS (middle a b) ∩ extended_distance_set.
extended_distance a w - max (extended_distance a w) (extended_distance b w))"
apply (rule cSUP_upper)
apply (simp add: assms(2) Bonk_Schramm_extension_unfolded_wo_props'(2))
by (rule bdd_aboveI2[of _ _ 0], auto)
ultimately have "0 ≤ (SUP w∈wo.underS (middle a b) ∩ extended_distance_set.
extended_distance a w - max (extended_distance a w) (extended_distance b w))"
by auto
moreover have "(SUP w∈wo.underS (middle a b) ∩ extended_distance_set.
extended_distance a w - max (extended_distance a w) (extended_distance b w)) ≤ 0"
apply (rule cSUP_least)
using assms(1) Bonk_Schramm_extension_unfolded_wo_props'(1) by (fastforce, auto)
moreover have "extended_distance a (middle a b) = (extended_distance a b)/2
+ (SUP w∈wo.underS (middle a b) ∩ extended_distance_set.
extended_distance a w - max (extended_distance a w) (extended_distance b w))"
by (rule extended_distance_middle_formula, simp add: Bonk_Schramm_extension_unfolded_wo_props'(1))
ultimately show "extended_distance a (middle a b) = (extended_distance a b)/2"
by auto
have "0 = extended_distance b a - max (extended_distance a a) (extended_distance b a)"
using extended_distance_pos[OF assms] assms(1) extended_distance_set_def extended_distance_symmetric by auto
also have "... ≤ (SUP w∈wo.underS (middle a b) ∩ extended_distance_set.
extended_distance b w - max (extended_distance a w) (extended_distance b w))"
apply (rule cSUP_upper)
apply (simp add: assms(1) Bonk_Schramm_extension_unfolded_wo_props'(1))
by (rule bdd_aboveI2[of _ _ 0], auto)
ultimately have "0 ≤ (SUP w∈wo.underS (middle a b) ∩ extended_distance_set.
extended_distance b w - max (extended_distance a w) (extended_distance b w))"
by auto
moreover have "(SUP w∈wo.underS (middle a b) ∩ extended_distance_set.
extended_distance b w - max (extended_distance a w) (extended_distance b w)) ≤ 0"
apply (rule cSUP_least)
using assms(1) Bonk_Schramm_extension_unfolded_wo_props'(1) by (fastforce, auto)
moreover have "extended_distance b (middle a b) = (extended_distance a b)/2
+ (SUP w∈wo.underS (middle a b) ∩ extended_distance_set.
extended_distance b w - max (extended_distance a w) (extended_distance b w))"
by (rule extended_distance_middle_formula, simp add: Bonk_Schramm_extension_unfolded_wo_props'(2))
ultimately show "extended_distance b (middle a b) = (extended_distance a b)/2"
by auto
qed
lemma extended_distance_Cauchy:
assumes "⋀(n::nat). u n ∈ extended_distance_set"
and "∀eps > (0::real). ∃N. ∀n ≥ N. ∀m ≥ N. extended_distance (u n) (u m) < eps"
shows "would_be_Cauchy u ∈ extended_distance_set"
"(λn. extended_distance (u n) (would_be_Cauchy u)) ⇢ 0"
proof -
show 2: "would_be_Cauchy u ∈ extended_distance_set"
unfolding extended_distance_set_def extended_distance_def apply (simp, subst extend_distance_fp)
using assms unfolding extended_distance_set_def extended_distance_def by simp
have lim: "(λn. extended_distance y (u n)) ⇢ (extended_distance y (would_be_Cauchy u))"
if y: "y ∈ extended_distance_set ∩ wo.underS (would_be_Cauchy u)" for y
proof -
have "∃N. ∀n ≥ N. ∀m ≥ N. abs(extended_distance y (u n) - extended_distance y (u m)) < e" if "e > 0" for e
proof -
obtain N where *: "extended_distance (u n) (u m) < e" if "n ≥ N" "m ≥ N" for m n
using assms(2) that ‹e > 0› by meson
{
fix m n assume "m ≥ N" "n ≥ N"
then have e: "extended_distance (u n) (u m) < e" using * by auto
have "extended_distance y (u n) ≤ extended_distance y (u m) + extended_distance (u m) (u n)"
using extended_distance_triang_ineq y assms(1) by blast
then have 1: "extended_distance y (u n) - extended_distance y (u m) < e"
using e extended_distance_symmetric by auto
have "extended_distance y (u m) ≤ extended_distance y (u n) + extended_distance (u n) (u m)"
using extended_distance_triang_ineq y assms(1) by blast
then have "extended_distance y (u m) - extended_distance y (u n) < e"
using e extended_distance_symmetric by auto
then have "abs(extended_distance y (u n) - extended_distance y (u m)) < e"
using 1 by auto
}
then show ?thesis by auto
qed
then have "convergent (λn. extended_distance y (u n))"
by (simp add: Cauchy_iff real_Cauchy_convergent)
then have lim: "(λn. extended_distance y (u n)) ⇢ lim (λn. extended_distance y (u n))"
using convergent_LIMSEQ_iff by auto
have *: "wo.max2 y (would_be_Cauchy u) = would_be_Cauchy u" "y ≠ would_be_Cauchy u" using y by auto
have "extended_distance y (would_be_Cauchy u) = lim (λn. extended_distance (u n) y)"
unfolding extended_distance_def apply (subst extend_distance_fp) unfolding *
using *(2) y assms(2) extended_distance_def by auto
then show "(λn. extended_distance y (u n)) ⇢ extended_distance y (would_be_Cauchy u)"
using lim extended_distance_symmetric by auto
qed
have "∃N. ∀n ≥ N. abs(extended_distance (u n) (would_be_Cauchy u)) < e" if "e > 0" for e
proof -
obtain N where *: "extended_distance (u n) (u m) < e/2" if "n ≥ N" "m ≥ N" for m n
using assms(2) that ‹e > 0› by (meson half_gt_zero)
have "abs(extended_distance (u n) (would_be_Cauchy u)) ≤ e/2" if "n ≥ N" for n
proof -
have "eventually (λm. extended_distance (u n) (u m) ≤ e/2) sequentially"
apply (rule eventually_sequentiallyI[of N]) using *[OF ‹n ≥ N›] less_imp_le by auto
moreover have "(λm. extended_distance (u n) (u m)) ⇢ extended_distance (u n) (would_be_Cauchy u)"
apply (rule lim) using "2" extended_distance_set_Cauchy by auto
ultimately have "extended_distance (u n) (would_be_Cauchy u) ≤ e/2"
by (meson "*" LIMSEQ_le_const2 less_imp_le that)
then show ?thesis using extended_distance_pos[OF assms(1)[of n] 2] by auto
qed
then show ?thesis using ‹e > 0› by force
qed
then show "(λn. extended_distance (u n) (would_be_Cauchy u)) ⇢ 0"
using LIMSEQ_iff by force
qed
end
subsection ‹The Bonk Schramm extension›
quotient_type (overloaded) 'a Bonk_Schramm_extension =
"('a::metric_space) Bonk_Schramm_extension_unfolded"
/ partial: "λx y. (x ∈ extended_distance_set ∧ y ∈ extended_distance_set ∧ extended_distance x y = 0)"
unfolding part_equivp_def proof(auto intro!: ext simp: extended_distance_set_def)
show "∃x. extended_distance x x = 0"
using extended_distance_set_basepoint extended_distance_set_def by auto
next
fix x y z::"'a Bonk_Schramm_extension_unfolded"
assume H: "extended_distance x x = 0" "extended_distance y y = 0" "extended_distance z z = 0"
"extended_distance x y = 0" "extended_distance x z = 0"
have "extended_distance y z ≤ extended_distance y x + extended_distance x z"
apply (rule extended_distance_triang_ineq)
using H unfolding extended_distance_set_def by auto
also have "... ≤ 0"
by (auto simp add: extended_distance_symmetric H)
finally show "extended_distance y z = 0"
using extended_distance_pos[of y z] H unfolding extended_distance_set_def by auto
next
fix x y z::"'a Bonk_Schramm_extension_unfolded"
assume H: "extended_distance x x = 0" "extended_distance y y = 0" "extended_distance z z = 0"
"extended_distance x y = 0" "extended_distance y z = 0"
have "extended_distance x z ≤ extended_distance x y + extended_distance y z"
apply (rule extended_distance_triang_ineq)
using H unfolding extended_distance_set_def by auto
also have "... ≤ 0"
by (auto simp add: extended_distance_symmetric H)
finally show "extended_distance x z = 0"
using extended_distance_pos[of x z] H unfolding extended_distance_set_def by auto
qed (metis)
instantiation Bonk_Schramm_extension :: (metric_space) metric_space
begin
lift_definition dist_Bonk_Schramm_extension::"('a::metric_space) Bonk_Schramm_extension ⇒ 'a Bonk_Schramm_extension ⇒ real"
is "λx y. extended_distance x y"
proof -
fix x y z t::"'a Bonk_Schramm_extension_unfolded"
assume H: "x ∈ extended_distance_set ∧ y ∈ extended_distance_set ∧ extended_distance x y = 0"
"z ∈ extended_distance_set ∧ t ∈ extended_distance_set ∧ extended_distance z t = 0"
have "extended_distance x z ≤ extended_distance x y + extended_distance y t + extended_distance t z"
using extended_distance_triang_ineq[of x y z] extended_distance_triang_ineq[of y t z] H
by auto
also have "... = extended_distance y t"
using H by (auto simp add: extended_distance_symmetric)
finally have *: "extended_distance x z ≤ extended_distance y t" by simp
have "extended_distance y t ≤ extended_distance y x + extended_distance x z + extended_distance z t"
using extended_distance_triang_ineq[of y x t] extended_distance_triang_ineq[of x z t] H
by auto
also have "... = extended_distance x z"
using H by (auto simp add: extended_distance_symmetric)
finally show "extended_distance x z = extended_distance y t" using * by simp
qed
text ‹To define a metric space in the current library of Isabelle/HOL, one should also introduce
a uniformity structure and a topology, as follows (they are prescribed by the distance):›
definition uniformity_Bonk_Schramm_extension::"(('a Bonk_Schramm_extension) × ('a Bonk_Schramm_extension)) filter"
where "uniformity_Bonk_Schramm_extension = (INF e∈{0 <..}. principal {(x, y). dist x y < e})"
definition open_Bonk_Schramm_extension :: "'a Bonk_Schramm_extension set ⇒ bool"
where "open_Bonk_Schramm_extension U = (∀x∈U. eventually (λ(x', y). x' = x ⟶ y ∈ U) uniformity)"
instance proof
fix x y::"'a Bonk_Schramm_extension"
have C: "rep_Bonk_Schramm_extension x ∈ extended_distance_set"
"rep_Bonk_Schramm_extension y ∈ extended_distance_set"
using Quotient3_Bonk_Schramm_extension Quotient3_rep_reflp by fastforce+
show "(dist x y = 0) = (x = y)"
apply (subst Quotient3_rel_rep[OF Quotient3_Bonk_Schramm_extension, symmetric])
unfolding dist_Bonk_Schramm_extension_def using C by auto
next
fix x y z::"'a Bonk_Schramm_extension"
have C: "rep_Bonk_Schramm_extension x ∈ extended_distance_set"
"rep_Bonk_Schramm_extension y ∈ extended_distance_set"
"rep_Bonk_Schramm_extension z ∈ extended_distance_set"
using Quotient3_Bonk_Schramm_extension Quotient3_rep_reflp by fastforce+
show "dist x y ≤ dist x z + dist y z"
unfolding dist_Bonk_Schramm_extension_def apply auto
by (metis C extended_distance_symmetric extended_distance_triang_ineq)
qed (auto simp add: uniformity_Bonk_Schramm_extension_def open_Bonk_Schramm_extension_def)
end
instance Bonk_Schramm_extension :: (metric_space) complete_space
proof
fix X::"nat ⇒ 'a Bonk_Schramm_extension" assume "Cauchy X"
have *: "⋀n. rep_Bonk_Schramm_extension (X n) ∈ extended_distance_set"
using Quotient3_Bonk_Schramm_extension Quotient3_rep_reflp by fastforce
have **: "extended_distance (rep_Bonk_Schramm_extension (X n)) (rep_Bonk_Schramm_extension (X m)) = dist (X n) (X m)" for m n
unfolding dist_Bonk_Schramm_extension_def by auto
define y where "y = would_be_Cauchy (λn. rep_Bonk_Schramm_extension (X n))"
have "y ∈ extended_distance_set"
unfolding y_def apply (rule extended_distance_Cauchy)
using * ‹Cauchy X› unfolding Cauchy_def **[symmetric] by auto
define x where "x = abs_Bonk_Schramm_extension y"
have "dist (X n) x = extended_distance (rep_Bonk_Schramm_extension (X n)) y" for n
unfolding x_def apply (subst Quotient3_abs_rep[OF Quotient3_Bonk_Schramm_extension, symmetric])
apply (rule dist_Bonk_Schramm_extension.abs_eq) using * ‹y ∈ extended_distance_set›
by (auto simp add: extended_distance_set_def)
moreover have "(λn. extended_distance (rep_Bonk_Schramm_extension (X n)) y) ⇢ 0"
unfolding y_def apply (rule extended_distance_Cauchy)
using * ‹Cauchy X› unfolding Cauchy_def **[symmetric] by auto
ultimately have *: "(λn. dist (X n) x) ⇢ 0" by simp
have "X ⇢ x"
apply (rule tendstoI) using * by (auto simp add: order_tendsto_iff)
then show "convergent X" unfolding convergent_def by auto
qed
instance Bonk_Schramm_extension :: (metric_space) geodesic_space
proof (rule complete_with_middles_imp_geodesic)
fix x y::"'a Bonk_Schramm_extension"
have H: "rep_Bonk_Schramm_extension x ∈ extended_distance_set"
"rep_Bonk_Schramm_extension y ∈ extended_distance_set"
using Quotient3_Bonk_Schramm_extension Quotient3_rep_reflp by fastforce+
define M where "M = middle (rep_Bonk_Schramm_extension x) (rep_Bonk_Schramm_extension y)"
then have M: "M ∈ extended_distance_set"
using extended_distance_set_middle[OF H] by simp
define m where "m = abs_Bonk_Schramm_extension M"
have "dist x m = extended_distance (rep_Bonk_Schramm_extension x) M"
apply (subst Quotient3_abs_rep[OF Quotient3_Bonk_Schramm_extension, symmetric]) unfolding m_def
apply (rule dist_Bonk_Schramm_extension.abs_eq)
using H M extended_distance_set_def by auto
also have "... = extended_distance (rep_Bonk_Schramm_extension x) (rep_Bonk_Schramm_extension y) / 2"
unfolding M_def by (rule extended_distance_middle[OF H])
also have "... = dist x y / 2"
unfolding dist_Bonk_Schramm_extension_def by auto
finally have *: "dist x m = dist x y / 2" by simp
have "dist m y = extended_distance M (rep_Bonk_Schramm_extension y)"
apply (subst Quotient3_abs_rep[OF Quotient3_Bonk_Schramm_extension, of y, symmetric]) unfolding m_def
apply (rule dist_Bonk_Schramm_extension.abs_eq)
using H M extended_distance_set_def by auto
also have "... = extended_distance (rep_Bonk_Schramm_extension x) (rep_Bonk_Schramm_extension y) / 2"
unfolding M_def using extended_distance_middle(2)[OF H] by (simp add: extended_distance_symmetric)
also have "... = dist x y / 2"
unfolding dist_Bonk_Schramm_extension_def by auto
finally have "dist m y = dist x y / 2" by simp
then show "∃m. dist x m = dist x y / 2 ∧ dist m y = dist x y / 2"
using * by auto
qed
definition to_Bonk_Schramm_extension::"'a::metric_space ⇒ 'a Bonk_Schramm_extension"
where "to_Bonk_Schramm_extension x = abs_Bonk_Schramm_extension (basepoint x)"
lemma to_Bonk_Schramm_extension_isometry:
"isometry_on UNIV to_Bonk_Schramm_extension"
proof (rule isometry_onI)
fix x y::'a
show "dist (to_Bonk_Schramm_extension x) (to_Bonk_Schramm_extension y) = dist x y"
unfolding to_Bonk_Schramm_extension_def apply (subst dist_Bonk_Schramm_extension.abs_eq)
unfolding extended_distance_set_def by (auto simp add: extended_distance_basepoint)
qed
section ‹Bonk-Schramm extension of hyperbolic spaces›
subsection ‹The Bonk-Schramm extension preserves hyperbolicity›
text ‹A central feature of the Bonk-Schramm extension is that it preserves hyperbolicity, with the
same hyperbolicity constant $\delta$, as we prove now.›
lemma (in Gromov_hyperbolic_space) Bonk_Schramm_extension_unfolded_hyperbolic:
fixes x y z t::"('a::metric_space) Bonk_Schramm_extension_unfolded"
assumes "x ∈ extended_distance_set"
"y ∈ extended_distance_set"
"z ∈ extended_distance_set"
"t ∈ extended_distance_set"
shows "extended_distance x y + extended_distance z t ≤ max (extended_distance x z + extended_distance y t) (extended_distance x t + extended_distance y z) + 2 * deltaG(TYPE('a))"
proof -
interpret wo: wo_rel Bonk_Schramm_extension_unfolded_wo
using well_order_on_Well_order wo_rel_def wfrec_def metric_space_class.Bonk_Schramm_extension_unfolded_wo_props(1) by blast
have ineq_rec: "∀x y z t. x ∈ wo.under a ∩ extended_distance_set ⟶ y ∈ wo.under a ∩ extended_distance_set ⟶ z ∈ wo.under a ∩ extended_distance_set ⟶ t ∈ wo.under a ∩ extended_distance_set
⟶ extended_distance x y + extended_distance z t ≤ max (extended_distance x z + extended_distance y t) (extended_distance x t + extended_distance y z) + 2 * deltaG(TYPE('a))"
for a::"'a Bonk_Schramm_extension_unfolded"
proof (rule wo.well_order_induct[of _ a])
fix a::"'a Bonk_Schramm_extension_unfolded"
assume IH_orig: "∀b. b ≠ a ∧ (b, a) ∈ Bonk_Schramm_extension_unfolded_wo ⟶
(∀x y z t. x ∈ wo.under b ∩ extended_distance_set ⟶
y ∈ wo.under b ∩ extended_distance_set ⟶
z ∈ wo.under b ∩ extended_distance_set ⟶
t ∈ wo.under b ∩ extended_distance_set ⟶
extended_distance x y + extended_distance z t ≤ max (extended_distance x z + extended_distance y t) (extended_distance x t + extended_distance y z) + 2 * deltaG(TYPE('a)))"
then have IH: "extended_distance x y + extended_distance z t ≤ max (extended_distance x z + extended_distance y t) (extended_distance x t + extended_distance y z) + 2 * deltaG(TYPE('a))"
if "x ∈ wo.underS a ∩ extended_distance_set"
"y ∈ wo.underS a ∩ extended_distance_set"
"z ∈ wo.underS a ∩ extended_distance_set"
"t ∈ wo.underS a ∩ extended_distance_set"
for x y z t
proof -
define b where "b = wo.max2 (wo.max2 x y) (wo.max2 z t)"
have "b ∈ wo.underS a" using that b_def by auto
have "x ∈ wo.under b" "y ∈ wo.under b" "z ∈ wo.under b" "t ∈ wo.under b" unfolding b_def
apply (auto simp add: under_def)
by (metis UNIV_I metric_space_class.Bonk_Schramm_extension_unfolded_wo_props(1) mem_Collect_eq under_def well_order_on_Well_order wo.TOTALS wo.max2_iff)+
then show ?thesis using that IH_orig ‹b ∈ wo.underS a› underS_E by fastforce
qed
consider "a ∉ extended_distance_set" | "a ∈ extended_distance_set" by auto
then show "∀x y z t. x ∈ wo.under a ∩ extended_distance_set ⟶
y ∈ wo.under a ∩ extended_distance_set ⟶
z ∈ wo.under a ∩ extended_distance_set ⟶
t ∈ wo.under a ∩ extended_distance_set ⟶
extended_distance x y + extended_distance z t ≤ max (extended_distance x z + extended_distance y t) (extended_distance x t + extended_distance y z) + 2 * deltaG(TYPE('a))"
proof (cases)
case 1
then have "wo.under a ∩ extended_distance_set = wo.underS a ∩ extended_distance_set"
apply auto
apply (metis mem_Collect_eq underS_I under_def)
by (simp add: underS_E under_def)
then show ?thesis using IH by auto
next
case 2
then have a: "extended_distance a a = 0" unfolding metric_space_class.extended_distance_set_def by auto
have main_ineq: "extended_distance a y + extended_distance z t ≤ max (extended_distance a z + extended_distance y t) (extended_distance a t + extended_distance y z) + 2 * deltaG(TYPE('a))"
if yzt: "y ∈ wo.underS a ∩ extended_distance_set"
"z ∈ wo.underS a ∩ extended_distance_set"
"t ∈ wo.underS a ∩ extended_distance_set"
for y z t
proof (cases a)
case A: (basepoint a')
then have "y ∈ range basepoint" using metric_space_class.Bonk_Schramm_extension_unfolded_wo_props(2)
by (metis yzt(1) Compl_iff Int_iff range_eqI wo.max2_def wo.max2_underS'(2))
then obtain y' where y: "y = basepoint y'" by auto
have "z ∈ range basepoint" using metric_space_class.Bonk_Schramm_extension_unfolded_wo_props(2) A
by (metis yzt(2) Compl_iff Int_iff range_eqI wo.max2_def wo.max2_underS'(2))
then obtain z' where z: "z = basepoint z'" by auto
have "t ∈ range basepoint" using metric_space_class.Bonk_Schramm_extension_unfolded_wo_props(2) A
by (metis yzt(3) Compl_iff Int_iff range_eqI wo.max2_def wo.max2_underS'(2))
then obtain t' where t: "t = basepoint t'" by auto
show ?thesis
unfolding y z t A metric_space_class.extended_distance_basepoint
using hyperb_quad_ineq UNIV_I unfolding Gromov_hyperbolic_subset_def by auto
next
case C: (would_be_Cauchy u)
then have u: "would_be_Cauchy u ∈ extended_distance_set"
"u n ∈ extended_distance_set ∩ wo.underS (would_be_Cauchy u)" for n
using metric_space_class.extended_distance_set_Cauchy 2 by auto
have lim: "(λn. extended_distance y (u n)) ⇢ (extended_distance y (would_be_Cauchy u))"
if y: "y ∈ extended_distance_set" for y
proof -
have a: "abs(extended_distance y (u n) - extended_distance y (would_be_Cauchy u)) ≤ extended_distance (u n) (would_be_Cauchy u)" for n
using u(2)[of n] 2 y metric_space_class.extended_distance_triang_ineq unfolding C
apply (subst abs_le_iff) apply (auto simp add: algebra_simps)
by (metis metric_space_class.extended_distance_symmetric)
have b: "(λn. extended_distance (u n) (would_be_Cauchy u)) ⇢ 0"
unfolding C apply (rule metric_space_class.extended_distance_Cauchy(2))
using metric_space_class.extended_distance_set_Cauchy[of u] C 2 by auto
have "(λn. abs(extended_distance y (u n) - extended_distance y (would_be_Cauchy u))) ⇢ 0"
apply (rule tendsto_sandwich[of "λ_. 0", OF _ _ _ b]) using a by auto
then show "(λn. extended_distance y (u n)) ⇢ extended_distance y (would_be_Cauchy u)"
using Lim_null tendsto_rabs_zero_cancel by blast
qed
have "max (extended_distance (u n) z + extended_distance y t) (extended_distance (u n) t + extended_distance y z) + 2 * deltaG(TYPE('a)) - extended_distance (u n) y - extended_distance z t ≥ 0" for n
using IH[of "u n" y z t] u yzt C by auto
moreover have "(λn. max (extended_distance (u n) z + extended_distance y t) (extended_distance (u n) t + extended_distance y z) + 2 * deltaG(TYPE('a)) - extended_distance (u n) y - extended_distance z t)
⇢ max (extended_distance (would_be_Cauchy u) z + extended_distance y t) (extended_distance (would_be_Cauchy u) t + extended_distance y z) + 2 * deltaG(TYPE('a)) - extended_distance (would_be_Cauchy u) y - extended_distance z t"
apply (auto intro!: tendsto_intros)
using lim that u by (auto simp add: metric_space_class.extended_distance_symmetric)
ultimately have I: "max (extended_distance (would_be_Cauchy u) z + extended_distance y t) (extended_distance (would_be_Cauchy u) t + extended_distance y z) + 2 * deltaG(TYPE('a)) - extended_distance (would_be_Cauchy u) y - extended_distance z t ≥ 0"
using LIMSEQ_le_const by blast
then show ?thesis unfolding C by auto
next
case M: (middle c d)
then have cd: "c ∈ extended_distance_set ∩ wo.underS (middle c d)"
"d ∈ extended_distance_set ∩ wo.underS (middle c d)"
using 2 metric_space_class.extended_distance_set_middle'[of c d] by auto
have bdd: "bdd_above ((λw. extended_distance s w - max (extended_distance c w) (extended_distance d w))` (wo.underS (middle c d) ∩ extended_distance_set))"
if "s ∈ extended_distance_set" for s
proof (rule bdd_aboveI2)
fix w assume w: "w ∈ wo.underS (middle c d) ∩ extended_distance_set"
have "extended_distance s w ≤ extended_distance s c + extended_distance c w"
using w that metric_space_class.extended_distance_triang_ineq cd by auto
also have "... ≤ extended_distance s c + max (extended_distance c w) (extended_distance d w)"
by auto
finally show "extended_distance s w - max (extended_distance c w) (extended_distance d w)
≤ extended_distance s c"
by auto
qed
have I: "extended_distance y w - max (extended_distance c w) (extended_distance d w)
≤ max (extended_distance y z + extended_distance t (middle c d)) (extended_distance y t + extended_distance z (middle c d)) + 2 * deltaG(TYPE('a))
- (extended_distance c d)/2 - extended_distance z t"
if w: "w ∈ wo.underS (middle c d) ∩ extended_distance_set" for w
proof -
have J: "(extended_distance c d)/2 + extended_distance s w - max (extended_distance c w) (extended_distance d w) ≤ extended_distance s (middle c d)"
if "s ∈ wo.underS a ∩ extended_distance_set" for s
proof -
have "(extended_distance c d)/2 + extended_distance s w - max (extended_distance c w) (extended_distance d w)
≤ (extended_distance c d)/2
+ (SUP w∈wo.underS (middle c d) ∩ extended_distance_set. extended_distance s w - max (extended_distance c w) (extended_distance d w))"
apply auto apply (rule cSUP_upper) using w bdd that by auto
also have "... = extended_distance s (middle c d)"
apply (rule metric_space_class.extended_distance_middle_formula[symmetric]) using that M by auto
finally show ?thesis by simp
qed
have "(extended_distance c d)/2 + extended_distance y w - max (extended_distance c w) (extended_distance d w) + extended_distance z t
≤ (extended_distance c d)/2 + max (extended_distance y z + extended_distance t w) (extended_distance y t + extended_distance z w) + 2 * deltaG(TYPE('a)) - max (extended_distance c w) (extended_distance d w)"
using IH[of y w z t] w yzt M by (auto simp add: metric_space_class.extended_distance_symmetric)
also have "... = max (extended_distance y z + (extended_distance c d)/2 + extended_distance t w - max (extended_distance c w) (extended_distance d w))
(extended_distance y t + (extended_distance c d)/2 + extended_distance z w - max (extended_distance c w) (extended_distance d w))
+ 2 * deltaG(TYPE('a))"
by auto
also have "... ≤ max (extended_distance y z + extended_distance t (middle c d)) (extended_distance y t + extended_distance z (middle c d)) + 2 * deltaG(TYPE('a))"
using J[OF yzt(3)] J[OF yzt(2)] by auto
finally show ?thesis by simp
qed
have *: "(SUP w∈wo.underS (middle c d) ∩ extended_distance_set. extended_distance y w - max (extended_distance c w) (extended_distance d w)) ≤
max (extended_distance y z + extended_distance t (middle c d)) (extended_distance y t + extended_distance z (middle c d)) + 2 * deltaG(TYPE('a))
- (extended_distance c d)/2 - extended_distance z t"
apply (rule cSUP_least) using yzt(1) M I by auto
have "extended_distance y (middle c d) + extended_distance z t
= (extended_distance c d)/2 + (SUP w∈wo.underS (middle c d) ∩ extended_distance_set. extended_distance y w - max (extended_distance c w) (extended_distance d w)) + extended_distance z t"
apply simp apply (rule metric_space_class.extended_distance_middle_formula) using yzt(1) M by auto
also have "... ≤ max (extended_distance y z + extended_distance t (middle c d)) (extended_distance y t + extended_distance z (middle c d)) + 2 * deltaG(TYPE('a))"
using * by simp
finally show "extended_distance a y + extended_distance z t
≤ max (extended_distance a z + extended_distance y t) (extended_distance a t + extended_distance y z) + 2 * deltaG(TYPE('a))"
unfolding M by (auto simp add: metric_space_class.extended_distance_symmetric)
qed
show ?thesis
proof (auto)
fix x y z t assume H: "x ∈ wo.under a" "x ∈ extended_distance_set"
"y ∈ wo.under a" "y ∈ extended_distance_set"
"z ∈ wo.under a" "z ∈ extended_distance_set"
"t ∈ wo.under a" "t ∈ extended_distance_set"
have *: "((x ∈ wo.underS a ∩ extended_distance_set) ∨ (x = a))
∧ ((y ∈ wo.underS a ∩ extended_distance_set) ∨ (y = a))
∧ ((z ∈ wo.underS a ∩ extended_distance_set) ∨ (z = a))
∧ ((t ∈ wo.underS a ∩ extended_distance_set) ∨ (t = a))"
using H by (simp add: underS_def under_def)
have d: "2 * deltaG(TYPE('a)) ≥ 0" by auto
show "extended_distance x y + extended_distance z t ≤ max (extended_distance x z + extended_distance y t) (extended_distance x t + extended_distance y z) + 2 * deltaG(TYPE('a))"
using * apply (auto simp add: metric_space_class.extended_distance_symmetric a)
using IH[of x y z t] apply (simp add: metric_space_class.extended_distance_symmetric)
using main_ineq[of z x y] apply (simp add: metric_space_class.extended_distance_symmetric)
using main_ineq[of t x y] apply (simp add: metric_space_class.extended_distance_symmetric)
using 2 metric_space_class.extended_distance_triang_ineq[of x a y] H apply (simp add: metric_space_class.extended_distance_symmetric) using d apply linarith
using main_ineq[of x z t] apply (simp add: metric_space_class.extended_distance_symmetric)
using d apply linarith
using d apply linarith
using main_ineq[of y z t] apply (simp add: metric_space_class.extended_distance_symmetric)
using d apply linarith
using d apply linarith
using 2 metric_space_class.extended_distance_triang_ineq[of t a z] H apply (simp add: metric_space_class.extended_distance_symmetric) using d apply linarith
done
qed
qed
qed
define b where "b = wo.max2 (wo.max2 x y) (wo.max2 z t)"
have "x ∈ wo.under b" "y ∈ wo.under b" "z ∈ wo.under b" "t ∈ wo.under b" unfolding b_def
apply (auto simp add: under_def)
by (metis UNIV_I metric_space_class.Bonk_Schramm_extension_unfolded_wo_props(1) mem_Collect_eq under_def well_order_on_Well_order wo.TOTALS wo.max2_iff)+
then show ?thesis using ineq_rec[of b] assms by auto
qed
lemma (in Gromov_hyperbolic_space) Bonk_Schramm_extension_hyperbolic:
"Gromov_hyperbolic_subset (deltaG(TYPE('a))) (UNIV::('a Bonk_Schramm_extension) set)"
apply (rule Gromov_hyperbolic_subsetI, simp, transfer fixing: deltaG)
using metric_space_class.extended_distance_set_def Bonk_Schramm_extension_unfolded_hyperbolic by auto
instantiation Bonk_Schramm_extension :: (Gromov_hyperbolic_space) Gromov_hyperbolic_space_geodesic
begin
definition deltaG_Bonk_Schramm_extension::"('a Bonk_Schramm_extension) itself ⇒ real" where
"deltaG_Bonk_Schramm_extension _ = deltaG(TYPE('a))"
instance apply standard
unfolding deltaG_Bonk_Schramm_extension_def using Bonk_Schramm_extension_hyperbolic by auto
end
text ‹Finally, it follows that the Bonk Schramm extension of a $0$-hyperbolic space
(in which it embeds isometrically) is a metric tree or, equivalently, a geodesic $0$-hyperbolic
space (the equivalence is proved at the end of \verb+Geodesic_Spaces.thy+).›
instance Bonk_Schramm_extension :: (Gromov_hyperbolic_space_0) Gromov_hyperbolic_space_0_geodesic
by (standard, simp add: deltaG_Bonk_Schramm_extension_def delta0)
text ‹It then follows that it is also a metric tree, from what we have already proved.
We write explicitly for definiteness.›
instance Bonk_Schramm_extension :: (Gromov_hyperbolic_space_0) metric_tree
by standard
subsection ‹Applications›
text ‹We deduce that we can extend results on Gromov-hyperbolic spaces without the geodesicity assumption,
even if it is used in the proofs. These results are given for illustrative purpose mainly, as one
works most often in geodesic spaces anyway.
The following results have already been proved in hyperbolic geodesic spaces. The same results
follow in a general hyperbolic space, as everything is invariant under isometries and can thus
be pulled from the corresponding result in the Bonk Schramm extension. The straightforward proofs
only express this invariance under isometries of all the properties under consideration.›
proposition (in Gromov_hyperbolic_space) lipschitz_path_close_to_geodesic':
fixes c::"real ⇒ 'a"
assumes "lipschitz_on M {A..B} c"
"geodesic_segment_between G (c A) (c B)"
"x ∈ G"
shows "infdist x (c`{A..B}) ≤ (4/ln 2) * deltaG(TYPE('a)) * max 0 (ln (B-A)) + M"
proof -
interpret BS: Gromov_hyperbolic_space_geodesic "dist::('a Bonk_Schramm_extension ⇒ 'a Bonk_Schramm_extension ⇒ real)" "uniformity" "open" "(λ_. deltaG(TYPE('a)))"
apply standard using Bonk_Schramm_extension_hyperbolic by auto
have "infdist x (c`{A..B}) = infdist (to_Bonk_Schramm_extension x) ((to_Bonk_Schramm_extension o c)`{A..B})"
unfolding image_comp[symmetric] apply (rule isometry_preserves_infdist[symmetric, of UNIV])
using to_Bonk_Schramm_extension_isometry by auto
also have "... ≤ (4/ln 2) * deltaG(TYPE(('a))) * max 0 (ln (B-A)) + (1*M)"
apply (rule BS.lipschitz_path_close_to_geodesic[of _ _ _ _ "to_Bonk_Schramm_extension`G"])
apply (rule lipschitz_on_compose)
using assms apply simp
apply (meson UNIV_I isometry_on_lipschitz lipschitz_on_def to_Bonk_Schramm_extension_isometry)
unfolding comp_def apply (rule isometry_preserves_geodesic_segment_between[of UNIV])
using assms to_Bonk_Schramm_extension_isometry by auto
finally show ?thesis by auto
qed
theorem (in Gromov_hyperbolic_space) Morse_Gromov_theorem':
fixes f::"real ⇒ 'a"
assumes "lambda C-quasi_isometry_on {a..b} f"
"geodesic_segment_between G (f a) (f b)"
shows "hausdorff_distance (f`{a..b}) G ≤ 92 * lambda⇧2 * (C + deltaG(TYPE('a)))"
proof -
interpret BS: Gromov_hyperbolic_space_geodesic "dist::('a Bonk_Schramm_extension ⇒ 'a Bonk_Schramm_extension ⇒ real)" "uniformity" "open" "(λ_. deltaG(TYPE('a)))"
apply standard using Bonk_Schramm_extension_hyperbolic by auto
have "hausdorff_distance (f`{a..b}) (G) = hausdorff_distance ((to_Bonk_Schramm_extension o f)`{a..b}) ((to_Bonk_Schramm_extension)`G)"
unfolding image_comp[symmetric] apply (rule isometry_preserves_hausdorff_distance[symmetric, of UNIV])
using to_Bonk_Schramm_extension_isometry by auto
also have "... ≤ 92 * (lambda*1)^2 * ((C*1+0) + deltaG(TYPE('a)))"
apply (intro BS.Morse_Gromov_theorem quasi_isometry_on_compose[where Y = UNIV])
using assms isometry_quasi_isometry_on to_Bonk_Schramm_extension_isometry apply auto
using isometry_preserves_geodesic_segment_between by blast
finally show ?thesis by simp
qed
theorem (in Gromov_hyperbolic_space) Morse_Gromov_theorem2':
fixes c d::"real ⇒ 'a"
assumes "lambda C-quasi_isometry_on {A..B} c"
"lambda C-quasi_isometry_on {A..B} d"
"c A = d A" "c B = d B"
shows "hausdorff_distance (c`{A..B}) (d`{A..B}) ≤ 184 * lambda^2 * (C + deltaG(TYPE('a)))"
proof -
interpret BS: Gromov_hyperbolic_space_geodesic "dist::('a Bonk_Schramm_extension ⇒ 'a Bonk_Schramm_extension ⇒ real)" "uniformity" "open" "(λ_. deltaG(TYPE('a)))"
apply standard using Bonk_Schramm_extension_hyperbolic by auto
have "hausdorff_distance (c`{A..B}) (d`{A..B}) = hausdorff_distance ((to_Bonk_Schramm_extension o c)`{A..B}) ((to_Bonk_Schramm_extension o d)`{A..B})"
unfolding image_comp[symmetric] apply (rule isometry_preserves_hausdorff_distance[symmetric, of UNIV])
using to_Bonk_Schramm_extension_isometry by auto
also have "... ≤ 184 * (lambda*1)^2 * ((C*1+0) + deltaG(TYPE('a)))"
apply (intro BS.Morse_Gromov_theorem2 quasi_isometry_on_compose[where Y = UNIV])
using assms isometry_quasi_isometry_on to_Bonk_Schramm_extension_isometry by auto
finally show ?thesis by simp
qed
lemma Gromov_hyperbolic_invariant_under_quasi_isometry_explicit':
fixes f::"'a::geodesic_space ⇒ 'b::Gromov_hyperbolic_space"
assumes "lambda C-quasi_isometry f"
shows "Gromov_hyperbolic_subset (752 * lambda^3 * (C + deltaG(TYPE('b)))) (UNIV::('a set))"
proof -
interpret BS: Gromov_hyperbolic_space_geodesic "dist::('b Bonk_Schramm_extension ⇒ 'b Bonk_Schramm_extension ⇒ real)" "uniformity" "open" "(λ_. deltaG(TYPE('b)))"
apply standard using Bonk_Schramm_extension_hyperbolic by auto
have A: "(lambda * 1) (C * 1 + 0)-quasi_isometry_on UNIV (to_Bonk_Schramm_extension o f)"
by (rule quasi_isometry_on_compose[OF assms, of _ _ UNIV])
(auto simp add: isometry_quasi_isometry_on[OF to_Bonk_Schramm_extension_isometry])
have *: "deltaG(TYPE('b)) = deltaG(TYPE('b Bonk_Schramm_extension))"
by (simp add: deltaG_Bonk_Schramm_extension_def)
show ?thesis
unfolding *
apply (rule Gromov_hyperbolic_invariant_under_quasi_isometry_explicit[of _ _ "to_Bonk_Schramm_extension o f"])
using A by auto
qed
theorem Gromov_hyperbolic_invariant_under_quasi_isometry':
assumes "quasi_isometric (UNIV::('a::geodesic_space) set) (UNIV::('b::Gromov_hyperbolic_space) set)"
shows "∃delta. Gromov_hyperbolic_subset delta (UNIV::'a set)"
proof -
obtain C lambda f where f: "lambda C-quasi_isometry_between (UNIV::'a set) (UNIV::'b set) f"
using assms unfolding quasi_isometric_def by auto
show ?thesis using Gromov_hyperbolic_invariant_under_quasi_isometry_explicit'[OF quasi_isometry_betweenD(1)[OF f]] by blast
qed
end
Theory Gromov_Boundary
theory Gromov_Boundary
imports Gromov_Hyperbolicity Eexp_Eln
begin
section ‹Constructing a distance from a quasi-distance›
text ‹Below, we will construct a distance on the Gromov completion of a hyperbolic space. The
geometrical object that arises naturally is almost a distance, but it does not satisfy the triangular
inequality. There is a general process to turn such a quasi-distance into a genuine distance, as
follows: define the new distance $\tilde d(x,y)$ to be the infimum of $d(x, u_1) + d(u_1,u_2) +
\dotsb + d(u_{n-1},x)$ over all sequences of points (of any length) connecting $x$ to $y$.
It is clear that it satisfies the triangular inequality, is symmetric, and $\tilde d(x,y) \leq
d(x,y)$. What is not clear, however, is if $\tilde d(x,y)$ can be zero if $x \neq y$, or more
generally how one can bound $\tilde d$ from below. The main point of this contruction is that,
if $d$ satisfies the inequality $d(x,z) \leq \sqrt{2} \max(d(x,y), d(y,z))$, then one
has $\tilde d(x,y) \geq d(x,y)/2$ (and in particular $\tilde d$ defines the same topology, the
same set of Lipschitz functions, and so on, as $d$).
This statement can be found in [Bourbaki, topologie generale, chapitre 10] or in
[Ghys-de la Harpe] for instance. We follow their proof.
›
definition turn_into_distance::"('a ⇒ 'a ⇒ real) ⇒ ('a ⇒ 'a ⇒ real)"
where "turn_into_distance f x y = Inf {(∑ i ∈ {0..<n}. f (u i) (u (Suc i)))| u (n::nat). u 0 = x ∧ u n = y}"
locale Turn_into_distance =
fixes f::"'a ⇒ 'a ⇒ real"
assumes nonneg: "f x y ≥ 0"
and sym: "f x y = f y x"
and self_zero: "f x x = 0"
and weak_triangle: "f x z ≤ sqrt 2 * max (f x y) (f y z)"
begin
text ‹The two lemmas below are useful when dealing with Inf results, as they always require
the set under consideration to be non-empty and bounded from below.›
lemma bdd_below [simp]:
"bdd_below {(∑ i = 0..<n. f (u i) (u (Suc i)))| u (n::nat). u 0 = x ∧ u n = y}"
apply (rule bdd_belowI[of _ 0]) using nonneg by (auto simp add: sum_nonneg)
lemma nonempty:
"{∑i = 0..<n. f (u i) (u (Suc i)) |u n. u 0 = x ∧ u n = y} ≠ {}"
proof -
define u::"nat ⇒ 'a" where "u = (λn. if n = 0 then x else y)"
define n::nat where "n = 1"
have "u 0 = x ∧ u n = y" unfolding u_def n_def by auto
then have "(∑i = 0..<n. f (u i) (u (Suc i))) ∈ {∑i = 0..<n. f (u i) (u (Suc i)) |u n. u 0 = x ∧ u n = y}"
by auto
then show ?thesis by auto
qed
text ‹We can now prove that \verb+turn_into_distance f+ satisfies all the properties of a distance.
First, it is nonnegative.›
lemma TID_nonneg:
"turn_into_distance f x y ≥ 0"
unfolding turn_into_distance_def apply (rule cInf_greatest[OF nonempty])
using nonneg by (auto simp add: sum_nonneg)
text ‹For the symmetry, we use the symmetry of $f$, and go backwards along a chain of points,
replacing a sequence from $x$ to $y$ with a sequence from $y$ to $x$.›
lemma TID_sym:
"turn_into_distance f x y = turn_into_distance f y x"
proof -
have "turn_into_distance f x y ≤ Inf {(∑ i ∈ {0..<n}. f (u i) (u (Suc i)))| u (n::nat). u 0 = y ∧ u n = x}" for x y
proof (rule cInf_greatest[OF nonempty], auto)
fix u::"nat ⇒ 'a" and n assume U: "y = u 0" "x = u n"
define v::"nat ⇒'a" where "v = (λi. u (n-i))"
have V: "v 0 = x" "v n = y" unfolding v_def using U by auto
have "(∑i = 0..<n. f (u i) (u (Suc i))) = (∑i = 0..<n. (λi. f (u i) (u (Suc i))) (n-1-i))"
apply (rule sum.reindex_bij_betw[symmetric])
by (rule bij_betw_byWitness[of _ "λi. n-1-i"], auto)
also have "... = (∑ i = 0..<n. f (v (Suc i)) (v i))"
apply (rule sum.cong) unfolding v_def by (auto simp add: Suc_diff_Suc)
also have "... = (∑ i = 0..<n. f (v i) (v (Suc i)))"
using sym by auto
finally have "(∑i = 0..<n. f (u i) (u (Suc i))) = (∑ i = 0..<n. f (v i) (v (Suc i)))"
by simp
moreover have "turn_into_distance f x y ≤ (∑ i = 0..<n. f (v i) (v (Suc i)))"
unfolding turn_into_distance_def apply (rule cInf_lower)
using V by auto
finally show "turn_into_distance f (u n) (u 0) ≤ (∑i = 0..<n. f (u i) (u (Suc i)))"
using U by auto
qed
then have *: "turn_into_distance f x y ≤ turn_into_distance f y x" for x y
unfolding turn_into_distance_def by auto
show ?thesis using *[of x y] *[of y x] by simp
qed
text ‹There is a trivial upper bound by $f$, using the single chain $x, y$.›
lemma upper:
"turn_into_distance f x y ≤ f x y"
unfolding turn_into_distance_def proof (rule cInf_lower, auto)
define u::"nat ⇒ 'a" where "u = (λn. if n = 0 then x else y)"
define n::nat where "n = 1"
have "u 0 = x ∧ u n = y ∧ f x y = (∑i = 0..<n. f (u i) (u (Suc i)))" unfolding u_def n_def by auto
then show "∃u n. f x y = (∑i = 0..<n. f (u i) (u (Suc i))) ∧ u 0 = x ∧ u n = y"
by auto
qed
text ‹The new distance vanishes on a pair of equal points, as this is already the case for $f$.›
lemma TID_self_zero:
"turn_into_distance f x x = 0"
using upper[of x x] TID_nonneg[of x x] self_zero[of x] by auto
text ‹For the triangular inequality, we concatenate a sequence from $x$ to $y$ almost realizing the
infimum, and a sequence from $y$ to $z$ almost realizing the infimum, to obtain a sequence from
$x$ to $z$ along which the sums of $f$ is almost bounded by
\verb|turn_into_distance f x y + turn_into_distance f y z|.
›
lemma triangle:
"turn_into_distance f x z ≤ turn_into_distance f x y + turn_into_distance f y z"
proof -
have "turn_into_distance f x z ≤ turn_into_distance f x y + turn_into_distance f y z + e" if "e > 0" for e
proof -
have "Inf {(∑ i ∈ {0..<n}. f (u i) (u (Suc i)))| u (n::nat). u 0 = x ∧ u n = y} < turn_into_distance f x y + e/2"
unfolding turn_into_distance_def using ‹e > 0› by auto
then have "∃a ∈ {(∑ i ∈ {0..<n}. f (u i) (u (Suc i)))| u (n::nat). u 0 = x ∧ u n = y}. a < turn_into_distance f x y + e/2"
by (rule cInf_lessD[OF nonempty])
then obtain u n where U: "u 0 = x" "u n = y" "(∑ i ∈ {0..<n}. f (u i) (u (Suc i))) < turn_into_distance f x y + e/2"
by auto
have "Inf {(∑ i ∈ {0..<m}. f (v i) (v (Suc i)))| v (m::nat). v 0 = y ∧ v m = z} < turn_into_distance f y z + e/2"
unfolding turn_into_distance_def using ‹e > 0› by auto
then have "∃a ∈ {(∑ i ∈ {0..<m}. f (v i) (v (Suc i)))| v (m::nat). v 0 = y ∧ v m = z}. a < turn_into_distance f y z + e/2"
by (rule cInf_lessD[OF nonempty])
then obtain v m where V: "v 0 = y" "v m = z" "(∑ i ∈ {0..<m}. f (v i) (v (Suc i))) < turn_into_distance f y z + e/2"
by auto
define w where "w = (λi. if i < n then u i else v (i-n))"
have *: "w 0 = x" "w (n+m) = z"
unfolding w_def using U V by auto
have "turn_into_distance f x z ≤ (∑i = 0..<n+m. f (w i) (w (Suc i)))"
unfolding turn_into_distance_def apply (rule cInf_lower) using * by auto
also have "... = (∑i = 0..<n. f (w i) (w (Suc i))) + (∑i = n..<n+m. f (w i) (w (Suc i)))"
by (simp add: sum.atLeastLessThan_concat)
also have "... = (∑i = 0..<n. f (w i) (w (Suc i))) + (∑i = 0..<m. f (w (i+n)) (w (Suc (i+n))))"
by (auto intro!: sum.reindex_bij_betw[symmetric] bij_betw_byWitness[of _ "λi. i-n"])
also have "... = (∑i = 0..<n. f (u i) (u (Suc i))) + (∑i = 0..<m. f (v i) (v (Suc i)))"
unfolding w_def apply (auto intro!: sum.cong)
using U(2) V(1) Suc_lessI by fastforce
also have "... < turn_into_distance f x y + e/2 + turn_into_distance f y z + e/2"
using U(3) V(3) by auto
finally show ?thesis by auto
qed
then show ?thesis
using field_le_epsilon by blast
qed
text ‹Now comes the only nontrivial statement of the construction, the fact that the new
distance is bounded from below by $f/2$.
Here is the mathematical proof. We show by induction that all chains from $x$ to
$y$ satisfy this bound. Assume this is done for all chains of length $ < n$, we do it for a
chain of length $n$. Write $S = \sum f(u_i, u_{i+1})$ for the sum along the chain. Introduce $p$
the last index where the sum is $\leq S/2$. Then the sum from $0$ to $p$ is $\leq S/2$, and the sum
from $p+1$ to $n$ is also $\leq S/2$ (by maximality of $p$). The induction assumption
gives that $f (x, u_p)$ is bounded by twice the sum from $0$ to $p$, which is at most $S$. Same
thing for $f(u_{p+1}, y)$. With the weird triangle inequality applied two times, we get
$f (x, y) \leq 2 \max(f(x,u_p), f(u_p, u_{p+1}), f(u_{p+1}, y)) \leq 2S$, as claimed.
The formalization presents no difficulty.
›
lemma lower:
"f x y ≤ 2 * turn_into_distance f x y"
proof -
have I: "f (u 0) (u n) ≤ (∑ i ∈ {0..<n}. f (u i) (u (Suc i))) * 2" for n u
proof (induction n arbitrary: u rule: less_induct)
case (less n)
show "f (u 0) (u n) ≤ (∑i = 0..<n. f (u i) (u (Suc i))) * 2"
proof (cases "n = 0")
case True
then have "f (u 0) (u n) = 0" using self_zero by auto
then show ?thesis using True by auto
next
case False
then have "n > 0" by auto
define S where "S = (∑i = 0..<n. f (u i) (u (Suc i)))"
have "S ≥ 0" unfolding S_def using nonneg by (auto simp add: sum_nonneg)
have "∃p. p < n ∧ (∑i = 0..<p. f (u i) (u (Suc i))) ≤ S/2 ∧ (∑i = Suc p..<n. f (u i) (u (Suc i))) ≤ S/2"
proof (cases "S = 0")
case True
have "(∑i = Suc 0..<n. f (u i) (u (Suc i))) = (∑i = 0..<n. f (u i) (u (Suc i))) - f(u 0) (u (Suc 0))"
using sum.atLeast_Suc_lessThan[OF ‹n > 0›, of "λi. f (u i) (u (Suc i))"] by simp
also have "... ≤ S/2" using True S_def nonneg by auto
finally have "0 < n ∧ (∑i = 0..<0. f (u i) (u (Suc i))) ≤ S/2 ∧ (∑i = Suc 0..<n. f (u i) (u (Suc i))) ≤ S/2"
using ‹n > 0› ‹S = 0› by auto
then show ?thesis by auto
next
case False
then have "S > 0" using ‹S ≥ 0› by simp
define A where "A = {q. q ≤ n ∧ (∑i = 0..<q. f (u i) (u (Suc i))) ≤ S/2}"
have "0 ∈ A" unfolding A_def using ‹S > 0› ‹n > 0› by auto
have "n ∉ A" unfolding A_def using ‹S > 0› unfolding S_def by auto
define p where "p = Max A"
have "p ∈ A" unfolding p_def apply (rule Max_in) using ‹0 ∈ A› unfolding A_def by auto
then have L: "p ≤ n" "(∑i = 0..<p. f (u i) (u (Suc i))) ≤ S/2" unfolding A_def by auto
then have "p < n" using ‹n ∉ A› ‹p ∈ A› le_neq_trans by blast
have "Suc p ∉ A" unfolding p_def
by (metis (no_types, lifting) A_def Max_ge Suc_n_not_le_n infinite_nat_iff_unbounded mem_Collect_eq not_le p_def)
then have *: "(∑i = 0..<Suc p. f (u i) (u (Suc i))) > S/2"
unfolding A_def using ‹p < n› by auto
have "(∑ i = Suc p..<n. f (u i) (u (Suc i))) = S - (∑i = 0..<Suc p. f (u i) (u (Suc i)))"
unfolding S_def using ‹p < n› by (metis (full_types) Suc_le_eq sum_diff_nat_ivl zero_le)
also have "... ≤ S/2" using * by auto
finally have "p < n ∧ (∑i = 0..<p. f (u i) (u (Suc i))) ≤ S/2 ∧ (∑i = Suc p..<n. f (u i) (u (Suc i))) ≤ S/2"
using ‹p < n› L(2) by auto
then show ?thesis by auto
qed
then obtain p where P: "p < n" "(∑i = 0..<p. f (u i) (u (Suc i))) ≤ S/2" "(∑i = Suc p..<n. f (u i) (u (Suc i))) ≤ S/2"
by auto
have "f (u 0) (u p) ≤ (∑i = 0..<p. f (u i) (u (Suc i))) * 2"
apply (rule less.IH) using ‹p < n› by auto
then have A: "f (u 0) (u p) ≤ S" using P(2) by auto
have B: "f (u p) (u (Suc p)) ≤ S"
apply (rule sum_nonneg_leq_bound[of "{0..<n}" "λi. f (u i) (u (Suc i))"])
using nonneg S_def ‹p < n› by auto
have "f (u (0 + Suc p)) (u ((n-Suc p) + Suc p)) ≤ (∑i = 0..<n-Suc p. f (u (i + Suc p)) (u (Suc i + Suc p))) * 2"
apply (rule less.IH) using ‹n > 0› by auto
also have "... = 2 * (∑i = Suc p..<n. f (u i) (u (Suc i)))"
by (auto intro!: sum.reindex_bij_betw bij_betw_byWitness[of _ "λi. i - Suc p"])
also have "... ≤ S" using P(3) by simp
finally have C: "f (u (Suc p)) (u n) ≤ S"
using ‹p < n› by auto
have "f (u 0) (u n) ≤ sqrt 2 * max (f (u 0) (u p)) (f (u p) (u n))"
using weak_triangle by simp
also have "... ≤ sqrt 2* max (f (u 0) (u p)) (sqrt 2 * max (f (u p) (u (Suc p))) (f (u (Suc p)) (u n)))"
using weak_triangle by simp (meson max.cobounded2 order_trans)
also have "... ≤ sqrt 2 * max S (sqrt 2 * max S S)"
using A B C by auto (simp add: le_max_iff_disj)
also have "... ≤ sqrt 2 * max (sqrt 2 * S) (sqrt 2 * max S S)"
apply (intro mult_left_mono max.mono) using ‹S ≥ 0› less_eq_real_def by auto
also have "... = 2 * S"
by auto
finally show ?thesis
unfolding S_def by simp
qed
qed
have "f x y/2 ≤ turn_into_distance f x y"
unfolding turn_into_distance_def by (rule cInf_greatest[OF nonempty], auto simp add: I)
then show ?thesis by simp
qed
end
section ‹The Gromov completion of a hyperbolic space›
subsection ‹The Gromov boundary as a set›
text ‹A sequence in a Gromov hyperbolic space converges to a point in the boundary if
the Gromov product $(u_n, u_m)_e$ tends to infinity when $m,n \to _infty$. The point at infinity
is defined as the equivalence class of such sequences, for the relation $u \sim v$ iff
$(u_n, v_n)_e \to \infty$ (or, equivalently, $(u_n, v_m)_e \to \infty$ when $m, n\to \infty$, or
one could also change basepoints). Hence, the Gromov boundary is naturally defined as a quotient
type. There is a difficulty: it can be empty in general, hence defining it as a type is not always
possible. One could introduce a new typeclass of Gromov hyperbolic spaces for which the boundary
is not empty (unboundedness is not enough, think of infinitely many segments $[0,n]$ all joined at
$0$), and then only define the boundary of such spaces. However, this is tedious. Rather, we
work with the Gromov completion (containing the space and its boundary), this is always not empty.
The price to pay is that, in the definition of the completion, we have to distinguish between
sequences converging to the boundary and sequences converging inside the space. This is more natural
to proceed in this way as the interesting features of the boundary come from the fact that its sits
at infinity of the initial space, so their relations (and the topology of $X \cup \partial X$) are
central.›
definition Gromov_converging_at_boundary::"(nat ⇒ ('a::Gromov_hyperbolic_space)) ⇒ bool"
where "Gromov_converging_at_boundary u = (∀a. ∀(M::real). ∃N. ∀n ≥ N. ∀ m ≥ N. Gromov_product_at a (u m) (u n) ≥ M)"
lemma Gromov_converging_at_boundaryI:
assumes "⋀M. ∃N. ∀n ≥ N. ∀m ≥ N. Gromov_product_at a (u m) (u n) ≥ M"
shows "Gromov_converging_at_boundary u"
unfolding Gromov_converging_at_boundary_def proof (auto)
fix b::'a and M::real
obtain N where *: "⋀m n. n ≥ N ⟹ m ≥ N ⟹ Gromov_product_at a (u m) (u n) ≥ M + dist a b"
using assms[of "M + dist a b"] by auto
have "Gromov_product_at b (u m) (u n) ≥ M" if "m ≥ N" "n ≥ N" for m n
using *[OF that] Gromov_product_at_diff1[of a "u m" "u n" b] by (smt Gromov_product_commute)
then show "∃N. ∀n ≥ N. ∀m ≥ N. M ≤ Gromov_product_at b (u m) (u n)" by auto
qed
lemma Gromov_converging_at_boundary_imp_unbounded:
assumes "Gromov_converging_at_boundary u"
shows "(λn. dist a (u n)) ⇢ ∞"
proof -
have "∃N. ∀n ≥ N. dist a (u n) ≥ M" for M::real
using assms unfolding Gromov_converging_at_boundary_def Gromov_product_e_x_x[symmetric] by meson
then show ?thesis
unfolding tendsto_PInfty eventually_sequentially by (meson dual_order.strict_trans1 gt_ex less_ereal.simps(1))
qed
lemma Gromov_converging_at_boundary_imp_not_constant:
"¬(Gromov_converging_at_boundary (λn. x))"
using Gromov_converging_at_boundary_imp_unbounded[of "(λn. x)" "x"] Lim_bounded_PInfty by auto
lemma Gromov_converging_at_boundary_imp_not_constant':
assumes "Gromov_converging_at_boundary u"
shows "¬(∀m n. u m = u n)"
using Gromov_converging_at_boundary_imp_not_constant
by (metis (no_types) Gromov_converging_at_boundary_def assms order_refl)
text ‹We introduce a partial equivalence relation, defined over the sequences that converge to
infinity, and the constant sequences. Quotienting the space of admissible sequences by this
equivalence relation will give rise to the Gromov completion.›
definition Gromov_completion_rel::"(nat ⇒ 'a::Gromov_hyperbolic_space) ⇒ (nat ⇒ 'a) ⇒ bool"
where "Gromov_completion_rel u v =
(((Gromov_converging_at_boundary u ∧ Gromov_converging_at_boundary v ∧ (∀a. (λn. Gromov_product_at a (u n) (v n)) ⇢ ∞)))
∨ (∀n m. u n = v m ∧ u n = u m ∧ v n = v m))"
text ‹We need some basic lemmas to work separately with sequences tending to the boundary
and with constant sequences, as follows.›
lemma Gromov_completion_rel_const [simp]:
"Gromov_completion_rel (λn. x) (λn. x)"
unfolding Gromov_completion_rel_def by auto
lemma Gromov_completion_rel_to_const:
assumes "Gromov_completion_rel u (λn. x)"
shows "u n = x"
using assms unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_not_constant[of x] by auto
lemma Gromov_completion_rel_to_const':
assumes "Gromov_completion_rel (λn. x) u"
shows "u n = x"
using assms unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_not_constant[of x] by auto
lemma Gromov_product_tendsto_PInf_a_b:
assumes "(λn. Gromov_product_at a (u n) (v n)) ⇢ ∞"
shows "(λn. Gromov_product_at b (u n) (v n)) ⇢ ∞"
proof (rule tendsto_sandwich[of "λn. ereal(Gromov_product_at a (u n) (v n)) + (- dist a b)" _ _ "λn. ∞"])
have "ereal(Gromov_product_at b (u n) (v n)) ≥ ereal(Gromov_product_at a (u n) (v n)) + (- dist a b)" for n
using Gromov_product_at_diff1[of a "u n" "v n" b] by auto
then show "∀⇩F n in sequentially. ereal (Gromov_product_at a (u n) (v n)) + ereal (- dist a b) ≤ ereal (Gromov_product_at b (u n) (v n))"
by auto
have "(λn. ereal(Gromov_product_at a (u n) (v n)) + (- dist a b)) ⇢ ∞ + (- dist a b)"
apply (intro tendsto_intros) using assms by auto
then show "(λn. ereal (Gromov_product_at a (u n) (v n)) + ereal (- dist a b)) ⇢ ∞" by simp
qed (auto)
lemma Gromov_converging_at_boundary_rel:
assumes "Gromov_converging_at_boundary u"
shows "Gromov_completion_rel u u"
unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_unbounded[OF assms] assms by auto
text ‹We can now prove that we indeed have an equivalence relation.›
lemma part_equivp_Gromov_completion_rel:
"part_equivp Gromov_completion_rel"
proof (rule part_equivpI)
show "∃x::(nat ⇒ 'a). Gromov_completion_rel x x"
apply (rule exI[of _ "λn. (SOME a::'a. True)"]) unfolding Gromov_completion_rel_def by (auto simp add: convergent_const)
show "symp Gromov_completion_rel"
unfolding symp_def Gromov_completion_rel_def by (auto simp add: Gromov_product_commute) metis+
show "transp (Gromov_completion_rel::(nat ⇒ 'a) ⇒ (nat ⇒ 'a) ⇒ bool)"
unfolding transp_def proof (intro allI impI)
fix u v w::"nat⇒'a"
assume UV: "Gromov_completion_rel u v"
and VW: "Gromov_completion_rel v w"
show "Gromov_completion_rel u w"
proof (cases "∀n m. v n = v m")
case True
define a where "a = v 0"
have *: "v = (λn. a)" unfolding a_def using True by auto
then have "u n = v 0" "w n = v 0" for n
using Gromov_completion_rel_to_const' Gromov_completion_rel_to_const UV VW unfolding * by auto force
then show ?thesis
using UV VW unfolding Gromov_completion_rel_def by auto
next
case False
have "(λn. Gromov_product_at a (u n) (w n)) ⇢ ∞" for a
proof (rule tendsto_sandwich[of "λn. min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n))) + (- deltaG(TYPE('a)))" _ _ "λn. ∞"])
have "min (Gromov_product_at a (u n) (v n)) (Gromov_product_at a (v n) (w n)) - deltaG(TYPE('a)) ≤ Gromov_product_at a (u n) (w n)" for n
by (rule hyperb_ineq)
then have "min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n))) + ereal (- deltaG TYPE('a)) ≤ ereal (Gromov_product_at a (u n) (w n))" for n
by (auto simp del: ereal_min simp add: ereal_min[symmetric])
then show "∀⇩F n in sequentially. min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n)))
+ ereal (- deltaG TYPE('a)) ≤ ereal (Gromov_product_at a (u n) (w n))"
unfolding eventually_sequentially by auto
have "(λn. min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n))) + (- deltaG(TYPE('a)))) ⇢ min ∞ ∞ + (- deltaG(TYPE('a)))"
apply (intro tendsto_intros) using UV VW False unfolding Gromov_completion_rel_def by auto
then show "(λn. min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n))) + (- deltaG(TYPE('a)))) ⇢ ∞" by auto
qed (auto)
then show ?thesis
using False UV VW unfolding Gromov_completion_rel_def by auto
qed
qed
qed
text ‹We can now define the Gromov completion of a Gromov hyperbolic space, considering either
sequences converging to a point on the boundary, or sequences converging inside the space, and
quotienting by the natural equivalence relation.›
quotient_type (overloaded) 'a Gromov_completion =
"nat ⇒ ('a::Gromov_hyperbolic_space)"
/ partial: "Gromov_completion_rel"
by (rule part_equivp_Gromov_completion_rel)
text ‹The Gromov completion contains is made of a copy of the original space, and new points
forming the Gromov boundary.›
definition to_Gromov_completion::"('a::Gromov_hyperbolic_space) ⇒ 'a Gromov_completion"
where "to_Gromov_completion x = abs_Gromov_completion (λn. x)"
definition from_Gromov_completion::"('a::Gromov_hyperbolic_space) Gromov_completion ⇒ 'a"
where "from_Gromov_completion = inv to_Gromov_completion"
definition Gromov_boundary::"('a::Gromov_hyperbolic_space) Gromov_completion set"
where "Gromov_boundary = UNIV - range to_Gromov_completion"
lemma to_Gromov_completion_inj:
"inj to_Gromov_completion"
proof (rule injI)
fix x y::'a assume H: "to_Gromov_completion x = to_Gromov_completion y"
have "Gromov_completion_rel (λn. x) (λn. y)"
apply (subst Quotient3_rel[OF Quotient3_Gromov_completion, symmetric])
using H unfolding to_Gromov_completion_def by auto
then show "x = y"
using Gromov_completion_rel_to_const by auto
qed
lemma from_to_Gromov_completion [simp]:
"from_Gromov_completion (to_Gromov_completion x) = x"
unfolding from_Gromov_completion_def by (simp add: to_Gromov_completion_inj)
lemma to_from_Gromov_completion:
assumes "x ∉ Gromov_boundary"
shows "to_Gromov_completion (from_Gromov_completion x) = x"
using assms to_Gromov_completion_inj unfolding Gromov_boundary_def from_Gromov_completion_def
by (simp add: f_inv_into_f)
lemma not_in_Gromov_boundary:
assumes "x ∉ Gromov_boundary"
shows "∃a. x = to_Gromov_completion a"
using assms unfolding Gromov_boundary_def by auto
lemma not_in_Gromov_boundary' [simp]:
"to_Gromov_completion x ∉ Gromov_boundary"
unfolding Gromov_boundary_def by auto
lemma abs_Gromov_completion_in_Gromov_boundary [simp]:
assumes "Gromov_converging_at_boundary u"
shows "abs_Gromov_completion u ∈ Gromov_boundary"
using Gromov_completion_rel_to_const Gromov_converging_at_boundary_imp_not_constant'
Gromov_converging_at_boundary_rel[OF assms]
Quotient3_rel[OF Quotient3_Gromov_completion] assms not_in_Gromov_boundary to_Gromov_completion_def
by fastforce
lemma rep_Gromov_completion_to_Gromov_completion [simp]:
"rep_Gromov_completion (to_Gromov_completion y) = (λn. y)"
proof -
have "Gromov_completion_rel (λn. y) (rep_Gromov_completion (abs_Gromov_completion (λn. y)))"
by (metis Gromov_completion_rel_const Quotient3_Gromov_completion rep_abs_rsp)
then show ?thesis
unfolding to_Gromov_completion_def using Gromov_completion_rel_to_const' by blast
qed
text ‹To distinguish the case of points inside the space or in the boundary, we introduce the
following case distinction.›
lemma Gromov_completion_cases [case_names to_Gromov_completion boundary, cases type: Gromov_completion]:
"(⋀x. z = to_Gromov_completion x ⟹ P) ⟹ (z ∈ Gromov_boundary ⟹ P) ⟹ P"
apply (cases "z ∈ Gromov_boundary") using not_in_Gromov_boundary by auto
subsection ‹Extending the original distance and the original Gromov product to the completion›
text ‹In this subsection, we extend the Gromov product to the boundary, by taking limits along
sequences tending to the point in the boundary. This does not converge, but it does up to $\delta$,
so for definiteness we use a $\liminf$ over all sequences tending to the boundary point -- one
interest of this definition is that the extended Gromov product still satisfies the hyperbolicity
inequality. One difficulty is that this extended Gromov product can take infinite values (it does
so exactly on the pair $(x,x)$ where $x$ is in the boundary), so we should define this product
in extended nonnegative reals.
We also extend the original distance, by $+\infty$ on the boundary. This is not a really interesting
function, but it will be instrumental below. Again, this extended Gromov distance (not to be mistaken
for the genuine distance we will construct later on on the completion) takes values in extended
nonnegative reals.
Since the extended Gromov product and the extension of the original distance both take values in
$[0,+\infty]$, it may seem natural to define them in ennreal. This is the choice that was made in
a previous implementation, but it turns out that one keeps computing with these numbers, writing
down inequalities and subtractions. ennreal is ill suited for this kind of computations, as it only
works well with additions. Hence, the implementation was switched to ereal, where proofs are indeed
much smoother.
To define the extended Gromov product, one takes a limit of the Gromov product along any
sequence, as it does not depend up to $\delta$ on the chosen sequence. However, if one wants to
keep the exact inequality that defines hyperbolicity, but at all points, then using an infimum
is the best choice.›
definition extended_Gromov_product_at::"('a::Gromov_hyperbolic_space) ⇒ 'a Gromov_completion ⇒ 'a Gromov_completion ⇒ ereal"
where "extended_Gromov_product_at e x y = Inf {liminf (λn. ereal(Gromov_product_at e (u n) (v n))) |u v. abs_Gromov_completion u = x ∧ abs_Gromov_completion v = y ∧ Gromov_completion_rel u u ∧ Gromov_completion_rel v v}"
definition extended_Gromov_distance::"('a::Gromov_hyperbolic_space) Gromov_completion ⇒ 'a Gromov_completion ⇒ ereal"
where "extended_Gromov_distance x y =
(if x ∈ Gromov_boundary ∨ y ∈ Gromov_boundary then ∞
else ereal (dist (inv to_Gromov_completion x) (inv to_Gromov_completion y)))"
text ‹The extended distance and the extended Gromov product are invariant under exchange
of the points, readily from the definition.›
lemma extended_Gromov_distance_commute:
"extended_Gromov_distance x y = extended_Gromov_distance y x"
unfolding extended_Gromov_distance_def by (simp add: dist_commute)
lemma extended_Gromov_product_nonneg [mono_intros, simp]:
"0 ≤ extended_Gromov_product_at e x y"
unfolding extended_Gromov_product_at_def by (rule Inf_greatest, auto intro: Liminf_bounded always_eventually)
lemma extended_Gromov_distance_nonneg [mono_intros, simp]:
"0 ≤ extended_Gromov_distance x y"
unfolding extended_Gromov_distance_def by auto
lemma extended_Gromov_product_at_commute:
"extended_Gromov_product_at e x y = extended_Gromov_product_at e y x"
unfolding extended_Gromov_product_at_def
proof (rule arg_cong[of _ _ Inf])
have "{liminf (λn. ereal (Gromov_product_at e (u n) (v n))) |u v.
abs_Gromov_completion u = x ∧ abs_Gromov_completion v = y ∧ Gromov_completion_rel u u ∧ Gromov_completion_rel v v} =
{liminf (λn. ereal (Gromov_product_at e (v n) (u n))) |u v.
abs_Gromov_completion v = y ∧ abs_Gromov_completion u = x ∧ Gromov_completion_rel v v ∧ Gromov_completion_rel u u}"
by (auto simp add: Gromov_product_commute)
then show "{liminf (λn. ereal (Gromov_product_at e (u n) (v n))) |u v.
abs_Gromov_completion u = x ∧ abs_Gromov_completion v = y ∧ Gromov_completion_rel u u ∧ Gromov_completion_rel v v} =
{liminf (λn. ereal (Gromov_product_at e (u n) (v n))) |u v.
abs_Gromov_completion u = y ∧ abs_Gromov_completion v = x ∧ Gromov_completion_rel u u ∧ Gromov_completion_rel v v}"
by auto
qed
text ‹Inside the space, the extended distance and the extended Gromov product coincide with the
original ones.›
lemma extended_Gromov_distance_inside [simp]:
"extended_Gromov_distance (to_Gromov_completion x) (to_Gromov_completion y) = dist x y"
unfolding extended_Gromov_distance_def Gromov_boundary_def by (auto simp add: to_Gromov_completion_inj)
lemma extended_Gromov_product_inside [simp] :
"extended_Gromov_product_at e (to_Gromov_completion x) (to_Gromov_completion y) = Gromov_product_at e x y"
proof -
have A: "u = (λn. z)" if H: "abs_Gromov_completion u = abs_Gromov_completion (λn. z)" "Gromov_completion_rel u u" for u and z::'a
proof -
have "Gromov_completion_rel u (λn. z)"
apply (subst Quotient3_rel[OF Quotient3_Gromov_completion, symmetric])
using H uniformity_dist_class_def by auto
then show ?thesis using Gromov_completion_rel_to_const by auto
qed
then have *: "{u. abs_Gromov_completion u = to_Gromov_completion z ∧ Gromov_completion_rel u u} = {(λn. z)}" for z::'a
unfolding to_Gromov_completion_def by auto
have **: "{F u v |u v. abs_Gromov_completion u = to_Gromov_completion x ∧ abs_Gromov_completion v = to_Gromov_completion y ∧ Gromov_completion_rel u u ∧ Gromov_completion_rel v v}
= {F (λn. x) (λn. y)}" for F::"(nat ⇒ 'a) ⇒ (nat ⇒ 'a) ⇒ ereal"
using *[of x] *[of y] unfolding extended_Gromov_product_at_def by (auto, smt mem_Collect_eq singletonD)
have "extended_Gromov_product_at e (to_Gromov_completion x) (to_Gromov_completion y) = Inf {liminf (λn. ereal(Gromov_product_at e ((λn. x) n) ((λn. y) n)))}"
unfolding extended_Gromov_product_at_def ** by simp
also have "... = ereal(Gromov_product_at e x y)"
by (auto simp add: Liminf_const)
finally show "extended_Gromov_product_at e (to_Gromov_completion x) (to_Gromov_completion y) = Gromov_product_at e x y"
by simp
qed
text ‹A point in the boundary is at infinite extended distance of everyone, including itself:
the extended distance is obtained by taking the supremum along all sequences tending to this point,
so even for one single point one can take two sequences tending to it at different speeds, which
results in an infinite extended distance.›
lemma extended_Gromov_distance_PInf_boundary [simp]:
assumes "x ∈ Gromov_boundary"
shows "extended_Gromov_distance x y = ∞" "extended_Gromov_distance y x = ∞"
unfolding extended_Gromov_distance_def using assms by auto
text ‹By construction, the extended distance still satisfies the triangle inequality.›
lemma extended_Gromov_distance_triangle [mono_intros]:
"extended_Gromov_distance x z ≤ extended_Gromov_distance x y + extended_Gromov_distance y z"
proof (cases "x ∈ Gromov_boundary ∨ y ∈ Gromov_boundary ∨ z ∈ Gromov_boundary")
case True
then have *: "extended_Gromov_distance x y + extended_Gromov_distance y z = ∞" by auto
show ?thesis by (simp add: *)
next
case False
then obtain a b c where abc: "x = to_Gromov_completion a" "y = to_Gromov_completion b" "z = to_Gromov_completion c"
unfolding Gromov_boundary_def by auto
show ?thesis
unfolding abc using dist_triangle[of a c b] ennreal_leI by fastforce
qed
text ‹The extended Gromov product can be bounded by the extended distance, just like inside
the space.›
lemma extended_Gromov_product_le_dist [mono_intros]:
"extended_Gromov_product_at e x y ≤ extended_Gromov_distance (to_Gromov_completion e) x"
proof (cases x)
case boundary
then show ?thesis by simp
next
case (to_Gromov_completion a)
define v where "v = rep_Gromov_completion y"
have *: "abs_Gromov_completion (λn. a) = x ∧ abs_Gromov_completion v = y ∧ Gromov_completion_rel (λn. a) (λn. a) ∧ Gromov_completion_rel v v"
unfolding v_def to_Gromov_completion to_Gromov_completion_def
by (auto simp add: Quotient3_rep_reflp[OF Quotient3_Gromov_completion] Quotient3_abs_rep[OF Quotient3_Gromov_completion])
have "extended_Gromov_product_at e x y ≤ liminf (λn. ereal(Gromov_product_at e a (v n)))"
unfolding extended_Gromov_product_at_def apply (rule Inf_lower) using * by force
also have "... ≤ liminf (λn. ereal(dist e a))"
using Gromov_product_le_dist(1)[of e a] by (auto intro!: Liminf_mono)
also have "... = ereal(dist e a)"
by (simp add: Liminf_const)
also have "... = extended_Gromov_distance (to_Gromov_completion e) x"
unfolding to_Gromov_completion by auto
finally show ?thesis by auto
qed
lemma extended_Gromov_product_le_dist' [mono_intros]:
"extended_Gromov_product_at e x y ≤ extended_Gromov_distance (to_Gromov_completion e) y"
using extended_Gromov_product_le_dist[of e y x] by (simp add: extended_Gromov_product_at_commute)
text ‹The Gromov product inside the space varies by at most the distance when one varies one of
the points. We will need the same statement for the extended Gromov product. The proof is done
using this inequality inside the space, and passing to the limit.›
lemma extended_Gromov_product_at_diff3 [mono_intros]:
"extended_Gromov_product_at e x y ≤ extended_Gromov_product_at e x z + extended_Gromov_distance y z"
proof (cases "(extended_Gromov_distance y z = ∞) ∨ (extended_Gromov_product_at e x z = ∞)")
case False
then have "y ∉ Gromov_boundary" "z ∉ Gromov_boundary"
using extended_Gromov_distance_PInf_boundary by auto
then obtain b c where b: "y = to_Gromov_completion b" and c: "z = to_Gromov_completion c"
unfolding Gromov_boundary_def by auto
have "extended_Gromov_distance y z = ereal(dist b c)"
unfolding b c by auto
have "extended_Gromov_product_at e x y ≤ (extended_Gromov_product_at e x z + extended_Gromov_distance y z) + h" if "h>0" for h
proof -
have "∃t∈{liminf (λn. ereal(Gromov_product_at e (u n) (w n))) |u w. abs_Gromov_completion u = x
∧ abs_Gromov_completion w = z ∧ Gromov_completion_rel u u ∧ Gromov_completion_rel w w}.
t < extended_Gromov_product_at e x z + h"
apply (subst Inf_less_iff[symmetric]) using False ‹h > 0› extended_Gromov_product_nonneg[of e x z] unfolding extended_Gromov_product_at_def[symmetric]
by (metis add.right_neutral ereal_add_left_cancel_less order_refl)
then obtain u w where H: "abs_Gromov_completion u = x" "abs_Gromov_completion w = z"
"Gromov_completion_rel u u" "Gromov_completion_rel w w"
"liminf (λn. ereal(Gromov_product_at e (u n) (w n))) < extended_Gromov_product_at e x z + h"
by auto
then have w: "w n = c" for n
using c Gromov_completion_rel_to_const Quotient3_Gromov_completion Quotient3_rel to_Gromov_completion_def by fastforce
define v where v: "v = (λn::nat. b)"
have "abs_Gromov_completion v = y" "Gromov_completion_rel v v"
unfolding v by (auto simp add: b to_Gromov_completion_def)
have "Gromov_product_at e (u n) (v n) ≤ Gromov_product_at e (u n) (w n) + dist b c" for n
unfolding v w using Gromov_product_at_diff3[of e "u n" b c] by auto
then have *: "ereal(Gromov_product_at e (u n) (v n)) ≤ ereal(Gromov_product_at e (u n) (w n)) + extended_Gromov_distance y z" for n
unfolding ‹extended_Gromov_distance y z = ereal(dist b c)› by fastforce
have "extended_Gromov_product_at e x y ≤ liminf(λn. ereal(Gromov_product_at e (u n) (v n)))"
unfolding extended_Gromov_product_at_def by (rule Inf_lower, auto, rule exI[of _ u], rule exI[of _ v], auto, fact+)
also have "... ≤ liminf(λn. ereal(Gromov_product_at e (u n) (w n)) + extended_Gromov_distance y z)"
apply (rule Liminf_mono) using * unfolding eventually_sequentially by auto
also have "... = liminf(λn. ereal(Gromov_product_at e (u n) (w n))) + extended_Gromov_distance y z"
apply (rule Liminf_add_ereal_right) using False by auto
also have "... ≤ extended_Gromov_product_at e x z + h + extended_Gromov_distance y z"
using less_imp_le[OF H(5)] by (auto intro: mono_intros)
finally show ?thesis
by (simp add: algebra_simps)
qed
then show ?thesis
using ereal_le_epsilon by blast
next
case True
then show ?thesis by auto
qed
lemma extended_Gromov_product_at_diff2 [mono_intros]:
"extended_Gromov_product_at e x y ≤ extended_Gromov_product_at e z y + extended_Gromov_distance x z"
using extended_Gromov_product_at_diff3[of e y x z] by (simp add: extended_Gromov_product_at_commute)
lemma extended_Gromov_product_at_diff1 [mono_intros]:
"extended_Gromov_product_at e x y ≤ extended_Gromov_product_at f x y + dist e f"
proof (cases "extended_Gromov_product_at f x y = ∞")
case False
have "extended_Gromov_product_at e x y ≤ (extended_Gromov_product_at f x y + dist e f) + h" if "h > 0" for h
proof -
have "∃t∈{liminf (λn. ereal(Gromov_product_at f (u n) (v n))) |u v. abs_Gromov_completion u = x
∧ abs_Gromov_completion v = y ∧ Gromov_completion_rel u u ∧ Gromov_completion_rel v v}.
t < extended_Gromov_product_at f x y + h"
apply (subst Inf_less_iff[symmetric]) using False ‹h > 0› extended_Gromov_product_nonneg[of f x y] unfolding extended_Gromov_product_at_def[symmetric]
by (metis add.right_neutral ereal_add_left_cancel_less order_refl)
then obtain u v where H: "abs_Gromov_completion u = x" "abs_Gromov_completion v = y"
"Gromov_completion_rel u u" "Gromov_completion_rel v v"
"liminf (λn. ereal(Gromov_product_at f (u n) (v n))) < extended_Gromov_product_at f x y + h"
by auto
have "Gromov_product_at e (u n) (v n) ≤ Gromov_product_at f (u n) (v n) + dist e f" for n
using Gromov_product_at_diff1[of e "u n" "v n" f] by auto
then have *: "ereal(Gromov_product_at e (u n) (v n)) ≤ ereal(Gromov_product_at f (u n) (v n)) + dist e f" for n
by fastforce
have "extended_Gromov_product_at e x y ≤ liminf(λn. ereal(Gromov_product_at e (u n) (v n)))"
unfolding extended_Gromov_product_at_def by (rule Inf_lower, auto, rule exI[of _ u], rule exI[of _ v], auto, fact+)
also have "... ≤ liminf(λn. ereal(Gromov_product_at f (u n) (v n)) + dist e f)"
apply (rule Liminf_mono) using * unfolding eventually_sequentially by auto
also have "... = liminf(λn. ereal(Gromov_product_at f (u n) (v n))) + dist e f"
apply (rule Liminf_add_ereal_right) using False by auto
also have "... ≤ extended_Gromov_product_at f x y + h + dist e f"
using less_imp_le[OF H(5)] by (auto intro: mono_intros)
finally show ?thesis
by (simp add: algebra_simps)
qed
then show ?thesis
using ereal_le_epsilon by blast
next
case True
then show ?thesis by auto
qed
text ‹A point in the Gromov boundary is represented by a sequence tending to infinity and
converging in the Gromov boundary, essentially by definition.›
lemma Gromov_boundary_abs_converging:
assumes "x ∈ Gromov_boundary" "abs_Gromov_completion u = x" "Gromov_completion_rel u u"
shows "Gromov_converging_at_boundary u"
proof -
have "Gromov_converging_at_boundary u ∨ (∀m n. u n = u m)"
using assms unfolding Gromov_completion_rel_def by auto
moreover have "¬(∀m n. u n = u m)"
proof (rule ccontr, simp)
assume *: "∀m n. u n = u m"
define z where "z = u 0"
then have z: "u = (λn. z)"
using * by auto
then have "x = to_Gromov_completion z"
using assms unfolding z to_Gromov_completion_def by auto
then show False using ‹x ∈ Gromov_boundary› unfolding Gromov_boundary_def by auto
qed
ultimately show ?thesis by auto
qed
lemma Gromov_boundary_rep_converging:
assumes "x ∈ Gromov_boundary"
shows "Gromov_converging_at_boundary (rep_Gromov_completion x)"
apply (rule Gromov_boundary_abs_converging[OF assms])
using Quotient3_Gromov_completion Quotient3_abs_rep Quotient3_rep_reflp by fastforce+
text ‹We can characterize the points for which the Gromov product is infinite: they have to be
the same point, at infinity. This is essentially equivalent to the definition of the Gromov
completion, but there is some boilerplate to get the proof working.›
lemma Gromov_boundary_extended_product_PInf [simp]:
"extended_Gromov_product_at e x y = ∞ ⟷ (x ∈ Gromov_boundary ∧ y = x)"
proof
fix x y::"'a Gromov_completion" assume "x ∈ Gromov_boundary ∧ y = x"
then have H: "y = x" "x ∈ Gromov_boundary" by auto
have *: "liminf (λn. ereal (Gromov_product_at e (u n) (v n))) = ∞" if
"abs_Gromov_completion u = x" "abs_Gromov_completion v = y"
"Gromov_completion_rel u u" "Gromov_completion_rel v v" for u v
proof -
have "Gromov_converging_at_boundary u" "Gromov_converging_at_boundary v"
using Gromov_boundary_abs_converging that H by auto
have "Gromov_completion_rel u v" using that ‹y = x›
using Quotient3_rel[OF Quotient3_Gromov_completion] by fastforce
then have "(λn. Gromov_product_at e (u n) (v n)) ⇢ ∞"
unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_not_constant'[OF ‹Gromov_converging_at_boundary u›] by auto
then show ?thesis
by (simp add: tendsto_iff_Liminf_eq_Limsup)
qed
then show "extended_Gromov_product_at e x y = ∞"
unfolding extended_Gromov_product_at_def by (auto intro: Inf_eqI)
next
fix x y::"'a Gromov_completion" assume H: "extended_Gromov_product_at e x y = ∞"
then have "extended_Gromov_distance (to_Gromov_completion e) x = ∞"
using extended_Gromov_product_le_dist[of e x y] neq_top_trans by auto
then have "x ∈ Gromov_boundary"
by (metis ereal.distinct(1) extended_Gromov_distance_def infinity_ereal_def not_in_Gromov_boundary')
have "extended_Gromov_distance (to_Gromov_completion e) y = ∞"
using extended_Gromov_product_le_dist[of e y x] neq_top_trans H by (auto simp add: extended_Gromov_product_at_commute)
then have "y ∈ Gromov_boundary"
by (metis ereal.distinct(1) extended_Gromov_distance_def infinity_ereal_def not_in_Gromov_boundary')
define u where "u = rep_Gromov_completion x"
define v where "v = rep_Gromov_completion y"
have A: "Gromov_converging_at_boundary u" "Gromov_converging_at_boundary v"
unfolding u_def v_def using ‹x ∈ Gromov_boundary› ‹y ∈ Gromov_boundary›
by (auto simp add: Gromov_boundary_rep_converging)
have "abs_Gromov_completion u = x ∧ abs_Gromov_completion v = y ∧ Gromov_completion_rel u u ∧ Gromov_completion_rel v v"
unfolding u_def v_def
using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion] by auto
then have "extended_Gromov_product_at e x y ≤ liminf (λn. ereal(Gromov_product_at e (u n) (v n)))"
unfolding extended_Gromov_product_at_def by (auto intro!: Inf_lower)
then have "(λn. ereal(Gromov_product_at e (u n) (v n))) ⇢ ∞"
unfolding H by (simp add: liminf_PInfty)
then have "(λn. ereal(Gromov_product_at a (u n) (v n))) ⇢ ∞" for a
using Gromov_product_tendsto_PInf_a_b by auto
then have "Gromov_completion_rel u v"
unfolding Gromov_completion_rel_def using A by auto
then have "abs_Gromov_completion u = abs_Gromov_completion v"
using Quotient3_rel_abs[OF Quotient3_Gromov_completion] by auto
then have "x = y"
unfolding u_def v_def Quotient3_abs_rep[OF Quotient3_Gromov_completion] by auto
then show "x ∈ Gromov_boundary ∧ y = x"
using ‹x ∈ Gromov_boundary› by auto
qed
text ‹As for points inside the space, we deduce that the extended Gromov product between $x$ and $x$
is just the extended distance to the basepoint.›
lemma extended_Gromov_product_e_x_x [simp]:
"extended_Gromov_product_at e x x = extended_Gromov_distance (to_Gromov_completion e) x"
proof (cases x)
case boundary
then show ?thesis using Gromov_boundary_extended_product_PInf by auto
next
case (to_Gromov_completion a)
then show ?thesis by auto
qed
text ‹The inequality in terms of Gromov products characterizing hyperbolicity extends in the
same form to the Gromov completion, by taking limits of this inequality in the space.›
lemma extended_hyperb_ineq [mono_intros]:
"extended_Gromov_product_at (e::'a::Gromov_hyperbolic_space) x z ≥
min (extended_Gromov_product_at e x y) (extended_Gromov_product_at e y z) - deltaG(TYPE('a))"
proof -
have "min (extended_Gromov_product_at e x y) (extended_Gromov_product_at e y z) - deltaG(TYPE('a)) ≤
Inf {liminf (λn. ereal (Gromov_product_at e (u n) (v n))) |u v.
abs_Gromov_completion u = x ∧ abs_Gromov_completion v = z ∧ Gromov_completion_rel u u ∧ Gromov_completion_rel v v}"
proof (rule cInf_greatest, auto)
define u where "u = rep_Gromov_completion x"
define w where "w = rep_Gromov_completion z"
have "abs_Gromov_completion u = x ∧ abs_Gromov_completion w = z ∧ Gromov_completion_rel u u ∧ Gromov_completion_rel w w"
unfolding u_def w_def
using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion] by auto
then show "∃t u. Gromov_completion_rel u u ∧
(∃v. abs_Gromov_completion v = z ∧ abs_Gromov_completion u = x ∧ t = liminf (λn. ereal (Gromov_product_at e (u n) (v n))) ∧ Gromov_completion_rel v v)"
by auto
next
fix u w assume H: "x = abs_Gromov_completion u" "z = abs_Gromov_completion w"
"Gromov_completion_rel u u" "Gromov_completion_rel w w"
define v where "v = rep_Gromov_completion y"
have Y: "y = abs_Gromov_completion v" "Gromov_completion_rel v v"
unfolding v_def
by (auto simp add: Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion])
have *: "min (ereal(Gromov_product_at e (u n) (v n))) (ereal(Gromov_product_at e (v n) (w n))) ≤ ereal(Gromov_product_at e (u n) (w n)) + deltaG(TYPE('a))" for n
by (subst ereal_min[symmetric], subst plus_ereal.simps(1), intro mono_intros)
have "extended_Gromov_product_at e (abs_Gromov_completion u) y ≤ liminf (λn. ereal(Gromov_product_at e (u n) (v n)))"
unfolding extended_Gromov_product_at_def using Y H by (auto intro!: Inf_lower)
moreover have "extended_Gromov_product_at e y (abs_Gromov_completion w) ≤ liminf (λn. ereal(Gromov_product_at e (v n) (w n)))"
unfolding extended_Gromov_product_at_def using Y H by (auto intro!: Inf_lower)
ultimately have "min (extended_Gromov_product_at e (abs_Gromov_completion u) y) (extended_Gromov_product_at e y (abs_Gromov_completion w))
≤ min (liminf (λn. ereal(Gromov_product_at e (u n) (v n)))) (liminf (λn. ereal(Gromov_product_at e (v n) (w n))))"
by (intro mono_intros, auto)
also have "... = liminf (λn. min (ereal(Gromov_product_at e (u n) (v n))) (ereal(Gromov_product_at e (v n) (w n))))"
by (rule Liminf_min_eq_min_Liminf[symmetric])
also have "... ≤ liminf (λn. ereal(Gromov_product_at e (u n) (w n)) + deltaG(TYPE('a)))"
using * by (auto intro!: Liminf_mono)
also have "... = liminf (λn. ereal(Gromov_product_at e (u n) (w n))) + deltaG(TYPE('a))"
by (intro Liminf_add_ereal_right, auto)
finally show "min (extended_Gromov_product_at e (abs_Gromov_completion u) y) (extended_Gromov_product_at e y (abs_Gromov_completion w))
≤ liminf (λn. ereal (Gromov_product_at e (u n) (w n))) + ereal (deltaG TYPE('a))"
by simp
qed
then show ?thesis unfolding extended_Gromov_product_at_def by auto
qed
lemma extended_hyperb_ineq' [mono_intros]:
"extended_Gromov_product_at (e::'a::Gromov_hyperbolic_space) x z + deltaG(TYPE('a)) ≥
min (extended_Gromov_product_at e x y) (extended_Gromov_product_at e y z)"
using extended_hyperb_ineq[of e x y z] unfolding ereal_minus_le_iff by (simp add: add.commute)
lemma zero_le_ereal [mono_intros]:
assumes "0 ≤ z"
shows "0 ≤ ereal z"
using assms by auto
lemma extended_hyperb_ineq_4_points' [mono_intros]:
"Min {extended_Gromov_product_at (e::'a::Gromov_hyperbolic_space) x y, extended_Gromov_product_at e y z, extended_Gromov_product_at e z t} ≤ extended_Gromov_product_at e x t + 2 * deltaG(TYPE('a))"
proof -
have "min (extended_Gromov_product_at e x y + 0) (min (extended_Gromov_product_at e y z) (extended_Gromov_product_at e z t))
≤ min (extended_Gromov_product_at e x y + deltaG(TYPE('a))) (extended_Gromov_product_at e y t + deltaG(TYPE('a))) "
by (intro mono_intros)
also have "... = min (extended_Gromov_product_at e x y) (extended_Gromov_product_at e y t) + deltaG(TYPE('a))"
by (simp add: add_mono_thms_linordered_semiring(3) dual_order.antisym min_def)
also have "... ≤ (extended_Gromov_product_at e x t + deltaG(TYPE('a))) + deltaG(TYPE('a))"
by (intro mono_intros)
finally show ?thesis apply (auto simp add: algebra_simps)
by (metis (no_types, hide_lams) add.commute add.left_commute mult_2_right plus_ereal.simps(1))
qed
lemma extended_hyperb_ineq_4_points [mono_intros]:
"Min {extended_Gromov_product_at (e::'a::Gromov_hyperbolic_space) x y, extended_Gromov_product_at e y z, extended_Gromov_product_at e z t} - 2 * deltaG(TYPE('a)) ≤ extended_Gromov_product_at e x t"
using extended_hyperb_ineq_4_points'[of e x y z] unfolding ereal_minus_le_iff by (simp add: add.commute)
subsection ‹Construction of the distance on the Gromov completion›
text ‹We want now to define the natural topology of the Gromov completion. Most textbooks
first define a topology on $\partial X$, or sometimes on
$X \cup \partial X$, and then much later a distance on $\partial X$ (but they never do the tedious
verification that the distance defines the same topology as the topology defined before). I have
not seen one textbook defining a distance on $X \cup \partial X$. It turns out that one can in fact
define a distance on $X \cup \partial X$, whose restriction to $\partial X$ is the usual distance
on the Gromov boundary, and define the topology of $X \cup \partial X$ using it. For formalization
purposes, this is very convenient as topologies defined with distances are automatically nice and
tractable (no need to check separation axioms, for instance). The price to pay is that, once
we have defined the distance, we have to check that it defines the right notion of convergence
one expects.
What we would like to take for the distance is
$d(x,y) = e^{-(x,y)_o}$, where $o$ is some fixed basepoint in the space. However, this
does not behave like a distance at small scales (but it is essentially the right thing at large
scales), and it does not really satisfy the triangle inequality. However, $e^{-\epsilon (x,y)_o}$
almost satisfies the triangle inequality if $\epsilon$ is small enough, i.e., it is equivalent
to a function satisfying the triangle inequality. This gives a genuine distance on the boundary,
but not inside the space as it does not vanish on pairs $(x,x)$.
A third try would be to take $d(x,y) = \min(\tilde d(x,y), e^{-\epsilon (x,y)_o})$ where
$\tilde d$ is the natural extension of $d$ to the Gromov completion (it is infinite if $x$ or $y$
belongs to the boundary). However, we can not prove that it is equivalent to a distance.
Finally, it works with $d(x,y) \asymp \min(\tilde d(x,y)^{1/2}, e^{-\epsilon (x,y)_o}$. This is
what we will prove below. To construct the distance, we use the results proved in
the locale \verb+Turn_into_distance+. For this, we need to check that our quasi-distance
satisfies a weird version of the triangular inequality.
All this construction depends on a basepoint, that we fix arbitrarily once and for all.
›
definition epsilonG::"('a::Gromov_hyperbolic_space) itself ⇒ real"
where "epsilonG _ = ln 2 / (2+2*deltaG(TYPE('a)))"
definition basepoint::"'a"
where "basepoint = (SOME a. True)"
lemma constant_in_extended_predist_pos [simp, mono_intros]:
"epsilonG(TYPE('a::Gromov_hyperbolic_space)) > 0"
"epsilonG(TYPE('a::Gromov_hyperbolic_space)) ≥ 0"
"ennreal (epsilonG(TYPE('a))) * top = top"
proof -
have *: "2+2*deltaG(TYPE('a)) ≥ 2 + 2 * 0"
by (intro mono_intros, auto)
show **: "epsilonG(TYPE('a)) > 0"
unfolding epsilonG_def apply (auto simp add: divide_simps) using * by auto
then show "ennreal (epsilonG(TYPE('a))) * top = top"
using ennreal_mult_top by auto
show "epsilonG(TYPE('a::Gromov_hyperbolic_space)) ≥ 0"
using ** by simp
qed
definition extended_predist::"('a::Gromov_hyperbolic_space) Gromov_completion ⇒ 'a Gromov_completion ⇒ real"
where "extended_predist x y = real_of_ereal (min (esqrt (extended_Gromov_distance x y))
(eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)))"
lemma extended_predist_ereal:
"ereal (extended_predist x (y::('a::Gromov_hyperbolic_space) Gromov_completion)) = min (esqrt (extended_Gromov_distance x y))
(eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y))"
proof -
have "eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y) ≤ eexp (0)"
by (intro mono_intros, simp add: ereal_mult_le_0_iff)
then have A: "min (esqrt (extended_Gromov_distance x y)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)) ≤ 1"
unfolding min_def using order_trans by fastforce
show ?thesis
unfolding extended_predist_def apply (rule ereal_real') using A by auto
qed
lemma extended_predist_nonneg [simp, mono_intros]:
"extended_predist x y ≥ 0"
unfolding extended_predist_def min_def by (auto intro: real_of_ereal_pos)
lemma extended_predist_commute:
"extended_predist x y = extended_predist y x"
unfolding extended_predist_def by (simp add: extended_Gromov_distance_commute extended_Gromov_product_at_commute)
lemma extended_predist_self0 [simp]:
"extended_predist x y = 0 ⟷ x = y"
proof (auto)
show "extended_predist y y = 0"
proof (cases y)
case boundary
then have *: "extended_Gromov_product_at basepoint y y = ∞"
using Gromov_boundary_extended_product_PInf by auto
show ?thesis unfolding extended_predist_def * apply (auto simp add: min_def)
using constant_in_extended_predist_pos(1)[where ?'a = 'a] boundary by auto
next
case (to_Gromov_completion a)
then show ?thesis unfolding extended_predist_def by (auto simp add: min_def)
qed
assume "extended_predist x y = 0"
then have "esqrt (extended_Gromov_distance x y) = 0 ∨ eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y) = 0"
by (metis extended_predist_ereal min_def zero_ereal_def)
then show "x = y"
proof
assume "esqrt (extended_Gromov_distance x y) = 0"
then have *: "extended_Gromov_distance x y = 0"
using extended_Gromov_distance_nonneg by (metis ereal_zero_mult esqrt_square)
then have "¬(x ∈ Gromov_boundary)" "¬(y ∈ Gromov_boundary)" by auto
then obtain a b where ab: "x = to_Gromov_completion a" "y = to_Gromov_completion b"
unfolding Gromov_boundary_def by auto
have "a = b" using * unfolding ab by auto
then show "x = y" using ab by auto
next
assume "eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y) = 0"
then have "extended_Gromov_product_at basepoint x y = ∞"
by auto
then show "x = y"
using Gromov_boundary_extended_product_PInf[of basepoint x y] by auto
qed
qed
lemma extended_predist_le1 [simp, mono_intros]:
"extended_predist x y ≤ 1"
proof -
have "eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y) ≤ eexp (0)"
by (intro mono_intros, simp add: ereal_mult_le_0_iff)
then have "min (esqrt (extended_Gromov_distance x y)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)) ≤ 1"
unfolding min_def using order_trans by fastforce
then show ?thesis
unfolding extended_predist_def by (simp add: real_of_ereal_le_1)
qed
lemma extended_predist_weak_triangle:
"extended_predist x z ≤ sqrt 2 * max (extended_predist x y) (extended_predist y z)"
proof -
have Z: "esqrt 2 = eexp (ereal(ln 2/2))"
by (subst esqrt_eq_iff_square, auto simp add: exp_add[symmetric])
have A: "eexp(ereal(epsilonG TYPE('a)) * 1) ≤ esqrt 2"
unfolding Z epsilonG_def apply auto
apply (auto simp add: algebra_simps divide_simps intro!: mono_intros)
using delta_nonneg[where ?'a = 'a] by auto
text ‹We have to show an inequality $d(x, z) \leq \sqrt{2} \max(d(x,y), d(y,z))$. Each of $d(x,y)$
and $d(y,z)$ is either the extended distance, or the exponential of minus the Gromov product,
depending on which is smaller. We split according to the four cases.›
have "(esqrt (extended_Gromov_distance x y) ≤ eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)
∨ esqrt (extended_Gromov_distance x y) ≥ eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y))
∧
((esqrt (extended_Gromov_distance y z) ≤ eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint y z)
∨ esqrt (extended_Gromov_distance y z) ≥ eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint y z)))"
by auto
then have "ereal(extended_predist x z) ≤ ereal (sqrt 2) * max (ereal(extended_predist x y)) (ereal (extended_predist y z))"
proof (auto)
text ‹First, consider the case where the minimum is the extended distance for both cases.
Then $ed(x,z) \leq ed(x,y) + ed(y,z) \leq 2 \max(ed(x,y), ed(y,z))$. Therefore, $ed(x,z)^{1/2}
\leq \sqrt{2} \max(ed(x,y)^{1/2}, ed(y,z)^{1/2})$. As predist is defined using
the square root of $ed$, this readily gives the result.›
assume H: "esqrt (extended_Gromov_distance x y) ≤ eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint x y)"
"esqrt (extended_Gromov_distance y z) ≤ eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint y z)"
have "extended_Gromov_distance x z ≤ extended_Gromov_distance x y + extended_Gromov_distance y z"
by (rule extended_Gromov_distance_triangle)
also have "... ≤ 2 * max (extended_Gromov_distance x y) (extended_Gromov_distance y z)"
by (simp add: add_mono add_mono_thms_linordered_semiring(1) mult_2_ereal)
finally have "esqrt (extended_Gromov_distance x z) ≤ esqrt (2 * max (extended_Gromov_distance x y) (extended_Gromov_distance y z))"
by (intro mono_intros)
also have "... = esqrt 2 * max (esqrt (extended_Gromov_distance x y)) (esqrt (extended_Gromov_distance y z))"
by (auto simp add: esqrt_mult max_of_mono[OF esqrt_mono])
finally show ?thesis unfolding extended_predist_ereal min_def using H by auto
next
text ‹Next, consider the case where the minimum comes from the Gromov product for both cases.
Then, the conclusion will come for the hyperbolicity inequality (which is valid in the Gromov
completion as well). There is an additive loss of $\delta$ in this inequality, which is converted
to a multiplicative loss after taking the exponential to get the distance. Since, in the formula
for the distance, the Gromov product is multiplied by a constant $\epsilon$ by design, the loss
we get in the end is $\exp(\delta \epsilon)$. The precise value of $\epsilon$ we have taken is
designed so that this is at most $\sqrt{2}$, giving the desired conclusion.›
assume H: "eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint x y) ≤ esqrt (extended_Gromov_distance x y)"
"eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint y z) ≤ esqrt (extended_Gromov_distance y z)"
text ‹First, check that $\epsilon$ and $\delta$ satisfy the required inequality
$\exp(\epsilon \delta) \leq \sqrt{2}$ (but in the extended reals as this is what we will use.›
have B: "eexp (epsilonG(TYPE('a)) * deltaG(TYPE('a))) ≤ esqrt 2"
unfolding epsilonG_def ‹esqrt 2 = eexp (ereal(ln 2/2))›
apply (auto simp add: algebra_simps divide_simps intro!: mono_intros)
using delta_nonneg[where ?'a = 'a] by auto
text ‹We start the computation. First, use the hyperbolicity inequality.›
have "eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x z)
≤ eexp (- epsilonG TYPE('a) * ((min (extended_Gromov_product_at basepoint x y) (extended_Gromov_product_at basepoint y z) - deltaG(TYPE('a)))))"
apply (subst uminus_ereal.simps(1)[symmetric], subst ereal_mult_minus_left)+ by (intro mono_intros)
text ‹Use distributivity to isolate the term $\epsilon \delta$. This requires some care
as multiplication is not distributive in general in ereal.›
also have "... = eexp (- epsilonG TYPE('a) * min (extended_Gromov_product_at basepoint x y) (extended_Gromov_product_at basepoint y z)
+ epsilonG TYPE('a) * deltaG TYPE('a))"
apply (rule cong[of eexp], auto)
apply (subst times_ereal.simps(1)[symmetric])
apply (subst ereal_distrib_minus_left, auto)
apply (subst uminus_ereal.simps(1)[symmetric])+
apply (subst ereal_minus(6))
by simp
text ‹Use multiplicativity of exponential to extract the multiplicative error factor.›
also have "... = eexp(- epsilonG TYPE('a) * (min (extended_Gromov_product_at basepoint x y) (extended_Gromov_product_at basepoint y z)))
* eexp(epsilonG(TYPE('a))* deltaG(TYPE('a)))"
by (rule eexp_add_mult, auto)
text ‹Extract the min outside of the exponential, using that all functions are monotonic.›
also have "... = eexp(epsilonG(TYPE('a))* deltaG(TYPE('a)))
* (max (eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y))
(eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z)))"
apply (subst max_of_antimono[of "λ (t::ereal). -epsilonG TYPE('a) * t", symmetric])
apply (metis antimonoI constant_in_extended_predist_pos(2) enn2ereal_ennreal enn2ereal_nonneg ereal_minus_le_minus ereal_mult_left_mono ereal_mult_minus_left uminus_ereal.simps(1))
apply (subst max_of_mono[OF eexp_mono])
apply (simp add: mult.commute)
done
text ‹We recognize the distance of $x$ to $y$ and the distance from $y$ to $z$ on the right.›
also have "... = eexp(epsilonG(TYPE('a)) * deltaG(TYPE('a))) * (max (ereal (extended_predist x y)) (extended_predist y z))"
unfolding extended_predist_ereal min_def using H by auto
also have "... ≤ esqrt 2 * max (ereal(extended_predist x y)) (ereal(extended_predist y z))"
apply (intro mono_intros B) using extended_predist_nonneg[of x y] by (simp add: max_def)
finally show ?thesis unfolding extended_predist_ereal min_def by auto
next
text ‹Next consider the case where $d(x,y)$ comes from the exponential of minus the Gromov product,
but $d(y,z)$ comes from their extended distance. Then $d(y,z) \leq 1$ (as $d(y,z)$ is smaller
then the exponential of minus the Gromov distance, which is at most $1$), and this is all we use:
the Gromov product between $x$ and $y$ or $x$ and $z$ differ by at most the distance from $y$ to $z$,
i.e., $1$. Then the result follows directly as $\exp(\epsilon) \leq \sqrt{2}$, by the choice of
$\epsilon$.›
assume H: "eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y) ≤ esqrt (extended_Gromov_distance x y)"
"esqrt (extended_Gromov_distance y z) ≤ eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z)"
then have "esqrt(extended_Gromov_distance y z) ≤ 1"
by (auto intro!: order_trans[OF H(2)] simp add: ereal_mult_le_0_iff)
then have "extended_Gromov_distance y z ≤ 1"
by (metis eq_iff esqrt_mono2 esqrt_simps(2) esqrt_square extended_Gromov_distance_nonneg le_cases zero_less_one_ereal)
have "ereal(extended_predist x z) ≤ eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x z)"
unfolding extended_predist_ereal min_def by auto
also have "... ≤ eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y
+ epsilonG TYPE('a) * extended_Gromov_distance y z)"
apply (intro mono_intros) apply (subst uminus_ereal.simps(1)[symmetric])+ apply (subst ereal_mult_minus_left)+
apply (intro mono_intros)
using extended_Gromov_product_at_diff3[of basepoint x y z]
by (meson constant_in_extended_predist_pos(2) ereal_le_distrib ereal_mult_left_mono order_trans zero_le_ereal)
also have "... ≤ eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y + ereal(epsilonG TYPE('a)) * 1)"
by (intro mono_intros, fact)
also have "... = eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y) * eexp(ereal(epsilonG TYPE('a)) * 1)"
by (rule eexp_add_mult, auto)
also have "... ≤ eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y) * esqrt 2"
by (intro mono_intros A)
also have "... = esqrt 2 * ereal(extended_predist x y)"
unfolding extended_predist_ereal min_def using H by (auto simp add: mult.commute)
also have "... ≤ esqrt 2 * max (ereal(extended_predist x y)) (ereal(extended_predist y z))"
unfolding max_def by (auto intro!: mono_intros)
finally show ?thesis by auto
next
text ‹The last case is the symmetric of the previous one, and is proved similarly.›
assume H: "eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z) ≤ esqrt (extended_Gromov_distance y z)"
"esqrt (extended_Gromov_distance x y) ≤ eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y)"
then have "esqrt(extended_Gromov_distance x y) ≤ 1"
by (auto intro!: order_trans[OF H(2)] simp add: ereal_mult_le_0_iff)
then have "extended_Gromov_distance x y ≤ 1"
by (metis eq_iff esqrt_mono2 esqrt_simps(2) esqrt_square extended_Gromov_distance_nonneg le_cases zero_less_one_ereal)
have "ereal(extended_predist x z) ≤ eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x z)"
unfolding extended_predist_ereal min_def by auto
also have "... ≤ eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z
+ epsilonG TYPE('a) * extended_Gromov_distance x y)"
apply (intro mono_intros) apply (subst uminus_ereal.simps(1)[symmetric])+ apply (subst ereal_mult_minus_left)+
apply (intro mono_intros)
using extended_Gromov_product_at_diff3[of basepoint z y x]
apply (simp add: extended_Gromov_product_at_commute extended_Gromov_distance_commute)
by (meson constant_in_extended_predist_pos(2) ereal_le_distrib ereal_mult_left_mono order_trans zero_le_ereal)
also have "... ≤ eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z + ereal(epsilonG TYPE('a)) * 1)"
by (intro mono_intros, fact)
also have "... = eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z) * eexp(ereal(epsilonG TYPE('a)) * 1)"
by (rule eexp_add_mult, auto)
also have "... ≤ eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z) * esqrt 2"
by (intro mono_intros A)
also have "... = esqrt 2 * ereal(extended_predist y z)"
unfolding extended_predist_ereal min_def using H by (auto simp add: mult.commute)
also have "... ≤ esqrt 2 * max (ereal(extended_predist x y)) (ereal(extended_predist y z))"
unfolding max_def by (auto intro!: mono_intros)
finally show ?thesis by auto
qed
then show "extended_predist x z ≤ sqrt 2 * max (extended_predist x y) (extended_predist y z)"
unfolding ereal_sqrt2[symmetric] max_of_mono[OF ereal_mono] times_ereal.simps(1) by auto
qed
instantiation Gromov_completion :: (Gromov_hyperbolic_space) metric_space
begin
definition dist_Gromov_completion::"('a::Gromov_hyperbolic_space) Gromov_completion ⇒ 'a Gromov_completion ⇒ real"
where "dist_Gromov_completion = turn_into_distance extended_predist"
text ‹To define a metric space in the current library of Isabelle/HOL, one should also introduce
a uniformity structure and a topology, as follows (they are prescribed by the distance):›
definition uniformity_Gromov_completion::"(('a Gromov_completion) × ('a Gromov_completion)) filter"
where "uniformity_Gromov_completion = (INF e∈{0 <..}. principal {(x, y). dist x y < e})"
definition open_Gromov_completion :: "'a Gromov_completion set ⇒ bool"
where "open_Gromov_completion U = (∀x∈U. eventually (λ(x', y). x' = x ⟶ y ∈ U) uniformity)"
instance proof
interpret Turn_into_distance extended_predist
by (standard, auto intro: extended_predist_weak_triangle extended_predist_commute)
fix x y z::"'a Gromov_completion"
show "(dist x y = 0) = (x = y)"
using TID_nonneg[of x y] lower[of x y] TID_self_zero upper[of x y] extended_predist_self0[of x y] unfolding dist_Gromov_completion_def
by (auto, linarith)
show "dist x y ≤ dist x z + dist y z"
unfolding dist_Gromov_completion_def using triangle by (simp add: TID_sym)
qed (auto simp add: uniformity_Gromov_completion_def open_Gromov_completion_def)
end
text ‹The only relevant property of the distance on the Gromov completion is that it is comparable
to the minimum of (the square root of) the extended distance, and the exponential of minus the Gromov
product. The precise formula we use to define it is just an implementation detail, in a sense.
We summarize these properties in the next theorem.
From this point on, we will only use this, and never come back to the definition based on
\verb+extended_predist+ and \verb+turn_into_distance+.›
theorem Gromov_completion_dist_comparison [mono_intros]:
fixes x y::"('a::Gromov_hyperbolic_space) Gromov_completion"
shows "ereal(dist x y) ≤ esqrt(extended_Gromov_distance x y)"
"ereal(dist x y) ≤ eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)"
"min (esqrt(extended_Gromov_distance x y)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)) ≤ 2 * ereal(dist x y)"
proof -
interpret Turn_into_distance extended_predist
by (standard, auto intro: extended_predist_weak_triangle extended_predist_commute)
have "ereal(dist x y) ≤ ereal(extended_predist x y)"
unfolding dist_Gromov_completion_def by (auto intro!: upper mono_intros)
then show "ereal(dist x y) ≤ esqrt(extended_Gromov_distance x y)"
"ereal(dist x y) ≤ eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)"
unfolding extended_predist_ereal by auto
have "ereal(extended_predist x y) ≤ ereal(2 * dist x y)"
unfolding dist_Gromov_completion_def by (auto intro!: lower mono_intros)
also have "... = 2 * ereal (dist x y)"
by simp
finally show "min (esqrt(extended_Gromov_distance x y)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)) ≤ 2 * ereal(dist x y)"
unfolding extended_predist_ereal by auto
qed
lemma Gromov_completion_dist_le_1 [simp, mono_intros]:
fixes x y::"('a::Gromov_hyperbolic_space) Gromov_completion"
shows "dist x y ≤ 1"
proof -
have "ereal(dist x y) ≤ eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)"
using Gromov_completion_dist_comparison(2)[of x y] by simp
also have "... ≤ eexp(-0)"
by (intro mono_intros) (simp add: ereal_mult_le_0_iff)
finally show ?thesis
by auto
qed
text ‹To avoid computations with exponentials, the following lemma is very convenient. It asserts
that if $x$ is close enough to infinity, and $y$ is close enough to $x$, then the Gromov product
between $x$ and $y$ is large.›
lemma large_Gromov_product_approx:
assumes "(M::ereal) < ∞"
shows "∃e D. e > 0 ∧ D < ∞ ∧ (∀x y. dist x y ≤ e ⟶ extended_Gromov_distance x (to_Gromov_completion basepoint) ≥ D ⟶ extended_Gromov_product_at basepoint x y ≥ M)"
proof -
obtain M0::real where "M ≤ ereal M0" using assms by (cases M, auto)
define e::real where "e = exp(-epsilonG(TYPE('a)) * M0)/2"
define D::ereal where "D = ereal M0 + 4"
have "e > 0"
unfolding e_def by auto
moreover have "D < ∞"
unfolding D_def by auto
moreover have "extended_Gromov_product_at basepoint x y ≥ M0"
if "dist x y ≤ e" "extended_Gromov_distance x (to_Gromov_completion basepoint) ≥ D" for x y::"'a Gromov_completion"
proof (cases "esqrt(extended_Gromov_distance x y) ≤ eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)")
case False
then have "eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y) ≤ 2 * ereal(dist x y)"
using Gromov_completion_dist_comparison(3)[of x y] unfolding min_def by auto
also have "... ≤ exp(-epsilonG(TYPE('a)) * M0)"
using ‹dist x y ≤ e› unfolding e_def by (auto simp add: numeral_mult_ennreal)
finally have "ereal M0 ≤ extended_Gromov_product_at basepoint x y"
unfolding eexp_ereal[symmetric] apply (simp only: eexp_le_eexp_iff_le)
unfolding times_ereal.simps(1)[symmetric] uminus_ereal.simps(1)[symmetric] ereal_mult_minus_left ereal_minus_le_minus
using ereal_mult_le_mult_iff[of "ereal (epsilonG TYPE('a))"] apply auto
by (metis ‹⋀r p. ereal (r * p) = ereal r * ereal p›)
then show "M0 ≤ extended_Gromov_product_at basepoint x y"
by auto
next
case True
then have "esqrt(extended_Gromov_distance x y) ≤ 2 * ereal(dist x y)"
using Gromov_completion_dist_comparison(3)[of x y] unfolding min_def by auto
also have "... ≤ esqrt 4"
by simp
finally have *: "extended_Gromov_distance x y ≤ 4"
unfolding esqrt_le using antisym by fastforce
have "ereal M0+4 ≤ D"
unfolding D_def by auto
also have "... ≤ extended_Gromov_product_at basepoint x x"
using that by (auto simp add: extended_Gromov_distance_commute)
also have "... ≤ extended_Gromov_product_at basepoint x y + extended_Gromov_distance x y"
by (rule extended_Gromov_product_at_diff3[of basepoint x x y])
also have "... ≤ extended_Gromov_product_at basepoint x y + 4"
by (intro mono_intros *)
finally show "M0 ≤ extended_Gromov_product_at basepoint x y"
by (metis (no_types, lifting) PInfty_neq_ereal(1) add.commute add_nonneg_nonneg ereal_add_strict_mono ereal_le_distrib mult_2_ereal not_le numeral_Bit0 numeral_eq_ereal one_add_one zero_less_one_ereal)
qed
ultimately show ?thesis using order_trans[OF ‹M ≤ ereal M0›] by force
qed
text ‹On the other hand, far away from infinity, it is equivalent to control the extended Gromov
distance or the new distance on the space.›
lemma inside_Gromov_distance_approx:
assumes "C < (∞::ereal)"
shows "∃e > 0. ∀x y. extended_Gromov_distance (to_Gromov_completion basepoint) x ≤ C ⟶ dist x y ≤ e
⟶ esqrt(extended_Gromov_distance x y) ≤ 2 * ereal(dist x y)"
proof -
obtain C0 where "C ≤ ereal C0" using assms by (cases C, auto)
define e0 where "e0 = exp(-epsilonG(TYPE('a)) * C0)"
have "e0 > 0"
unfolding e0_def using assms by auto
define e where "e = e0/4"
have "e > 0"
unfolding e_def using ‹e0 > 0› by auto
moreover have "esqrt(extended_Gromov_distance x y) ≤ 2 * ereal(dist x y)"
if "extended_Gromov_distance (to_Gromov_completion basepoint) x ≤ C0" "dist x y ≤ e" for x y::"'a Gromov_completion"
proof -
have R: "min a b ≤ c ⟹ a ≤ c ∨ b ≤ c" for a b c::ereal unfolding min_def
by presburger
have "2 * ereal (dist x y) ≤ 2 * ereal e"
using that by (intro mono_intros, auto)
also have "... = ereal(e0/2)"
unfolding e_def by auto
also have "... < ereal e0"
apply (intro mono_intros) using ‹e0 > 0› by auto
also have "... ≤ eexp(-epsilonG(TYPE('a)) * extended_Gromov_distance (to_Gromov_completion basepoint) x)"
unfolding e0_def eexp_ereal[symmetric] ereal_mult_minus_left mult_minus_left uminus_ereal.simps(1)[symmetric] times_ereal.simps(1)[symmetric]
by (intro mono_intros that)
also have "... ≤ eexp(-epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)"
unfolding ereal_mult_minus_left mult_minus_left uminus_ereal.simps(1)[symmetric] times_ereal.simps(1)[symmetric]
by (intro mono_intros)
finally show ?thesis
using R[OF Gromov_completion_dist_comparison(3)[of x y]] by auto
qed
ultimately show ?thesis using order_trans[OF _ ‹C ≤ ereal C0›] by auto
qed
subsection ‹Characterizing convergence in the Gromov boundary›
text ‹The convergence of sequences in the Gromov boundary can be characterized, essentially
by definition: sequences tend to a point at infinity iff the Gromov product with this point tends
to infinity, while sequences tend to a point inside iff the extended distance tends to $0$. In both
cases, it is just a matter of unfolding the definition of the distance, and see which one of the two
terms (exponential of minus the Gromov product, or extended distance) realizes the minimum. We have
constructed the distance essentially so that this property is satisfied.
We could also have defined first the topology, satisfying these conditions, but then we would have
had to check that it coincides with the topology that the distance defines, so it seems more
economical to proceed in this way.›
lemma Gromov_completion_boundary_limit:
assumes "x ∈ Gromov_boundary"
shows "(u ⤏ x) F ⟷ ((λn. extended_Gromov_product_at basepoint (u n) x) ⤏ ∞) F"
proof
assume *: "((λn. extended_Gromov_product_at basepoint (u n) x) ⤏ ∞) F"
have "((λn. ereal(dist (u n) x)) ⤏ 0) F"
proof (rule tendsto_sandwich[of "λ_. 0" _ _ "(λn. eexp (-epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))"])
have "((λn. eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)) ⤏ eexp (- epsilonG(TYPE('a)) * (∞::ereal))) F"
apply (intro tendsto_intros *) by auto
then show "((λn. eexp (-epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)) ⤏ 0) F"
using constant_in_extended_predist_pos(1)[where ?'a = 'a] by auto
qed (auto simp add: Gromov_completion_dist_comparison)
then have "((λn. real_of_ereal(ereal(dist (u n) x))) ⤏ 0) F"
by (simp add: zero_ereal_def)
then show "(u ⤏ x) F"
by (subst tendsto_dist_iff, auto)
next
assume *: "(u ⤏ x) F"
have A: "1 / ereal (- epsilonG TYPE('a)) * (ereal (- epsilonG TYPE('a))) = 1"
apply auto using constant_in_extended_predist_pos(1)[where ?'a = 'a] by auto
have a: "esqrt(extended_Gromov_distance (u n) x) = ∞" for n
unfolding extended_Gromov_distance_PInf_boundary(2)[OF assms, of "u n"] by auto
have "min (esqrt(extended_Gromov_distance (u n) x)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))
= eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)" for n
unfolding a min_def using neq_top_trans by force
moreover have "((λn. min (esqrt(extended_Gromov_distance (u n) x)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))) ⤏ 0) F"
proof (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. 2 * ereal(dist (u n) x)"])
have "((λn. 2 * ereal (dist (u n) x)) ⤏ 2 * ereal 0) F"
apply (intro tendsto_intros) using * tendsto_dist_iff by auto
then show "((λn. 2 * ereal (dist (u n) x)) ⤏ 0) F" by (simp add: zero_ereal_def)
show "∀⇩F n in F. 0 ≤ min (esqrt (extended_Gromov_distance (u n) x)) (eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))"
by (rule always_eventually, auto)
show "∀⇩F n in F.
min (esqrt (extended_Gromov_distance (u n) x)) (eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)) ≤ 2 * ereal (dist (u n) x)"
apply (rule always_eventually) using Gromov_completion_dist_comparison(3) by auto
qed (auto)
ultimately have "((λn. eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)) ⤏ 0) F"
by auto
then have "((λn. - epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x) ⤏ -∞) F"
unfolding eexp_special_values(3)[symmetric] eexp_tendsto' by auto
then have "((λn. 1/ereal(-epsilonG(TYPE('a))) * (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)) ⤏ 1/ereal(-epsilonG(TYPE('a))) * (-∞)) F"
by (intro tendsto_intros, auto)
moreover have "1/ereal(-epsilonG(TYPE('a))) * (-∞) = ∞"
apply auto using constant_in_extended_predist_pos(1)[where ?'a = 'a] by auto
ultimately show "((λn. extended_Gromov_product_at basepoint (u n) x) ⤏ ∞) F"
unfolding ab_semigroup_mult_class.mult_ac(1)[symmetric] A by auto
qed
lemma extended_Gromov_product_tendsto_PInf_a_b:
assumes "((λn. extended_Gromov_product_at a (u n) (v n)) ⤏ ∞) F"
shows "((λn. extended_Gromov_product_at b (u n) (v n)) ⤏ ∞) F"
proof (rule tendsto_sandwich[of "λn. extended_Gromov_product_at a (u n) (v n) - dist a b" _ _ "λ_. ∞"])
have "extended_Gromov_product_at a (u n) (v n) - ereal (dist a b) ≤ extended_Gromov_product_at b (u n) (v n)" for n
using extended_Gromov_product_at_diff1[of a "u n" "v n" b] by (simp add: add.commute ereal_minus_le_iff)
then show "∀⇩F n in F. extended_Gromov_product_at a (u n) (v n) - ereal (dist a b) ≤ extended_Gromov_product_at b (u n) (v n)"
by auto
have "((λn. extended_Gromov_product_at a (u n) (v n) - ereal (dist a b)) ⤏ ∞ - ereal (dist a b)) F"
by (intro tendsto_intros assms) auto
then show "((λn. extended_Gromov_product_at a (u n) (v n) - ereal (dist a b)) ⤏ ∞) F"
by auto
qed (auto)
lemma Gromov_completion_inside_limit:
assumes "x ∉ Gromov_boundary"
shows "(u ⤏ x) F ⟷ ((λn. extended_Gromov_distance (u n) x) ⤏ 0) F"
proof
assume *: "((λn. extended_Gromov_distance (u n) x) ⤏ 0) F"
have "((λn. ereal(dist (u n) x)) ⤏ ereal 0) F"
proof (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. esqrt (extended_Gromov_distance (u n) x)"])
have "((λn. esqrt (extended_Gromov_distance (u n) x)) ⤏ esqrt 0) F"
by (intro tendsto_intros *)
then show "((λn. esqrt (extended_Gromov_distance (u n) x)) ⤏ ereal 0) F"
by (simp add: zero_ereal_def)
qed (auto simp add: Gromov_completion_dist_comparison zero_ereal_def)
then have "((λn. real_of_ereal(ereal(dist (u n) x))) ⤏ 0) F"
by (intro lim_real_of_ereal)
then show "(u ⤏ x) F"
by (subst tendsto_dist_iff, auto)
next
assume *: "(u ⤏ x) F"
have "x ∈ range to_Gromov_completion" using assms unfolding Gromov_boundary_def by auto
have "((λn. esqrt(extended_Gromov_distance (u n) x)) ⤏ 0) F"
proof (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. 2 * ereal(dist (u n) x)"])
have A: "extended_Gromov_distance (to_Gromov_completion basepoint) x < ∞"
by (simp add: assms extended_Gromov_distance_def)
obtain e where e: "e > 0" "⋀y. dist x y ≤ e ⟹ esqrt(extended_Gromov_distance x y) ≤ 2 * ereal (dist x y)"
using inside_Gromov_distance_approx[OF A] by auto
have B: "eventually (λn. dist x (u n) < e) F"
using order_tendstoD(2)[OF iffD1[OF tendsto_dist_iff *] ‹e > 0›] by (simp add: dist_commute)
then have "eventually (λn. esqrt(extended_Gromov_distance x (u n)) ≤ 2 * ereal (dist x (u n))) F"
using eventually_mono[OF _ e(2)] less_imp_le by (metis (mono_tags, lifting))
then show "eventually (λn. esqrt(extended_Gromov_distance (u n) x) ≤ 2 * ereal (dist (u n) x)) F"
by (simp add: dist_commute extended_Gromov_distance_commute)
have "((λn. 2 * ereal(dist (u n) x)) ⤏ 2 * ereal 0) F"
apply (intro tendsto_intros) using tendsto_dist_iff * by auto
then show "((λn. 2 * ereal(dist (u n) x)) ⤏ 0) F"
by (simp add: zero_ereal_def)
qed (auto)
then have "((λn. esqrt(extended_Gromov_distance (u n) x) * esqrt(extended_Gromov_distance (u n) x)) ⤏ 0 * 0) F"
by (intro tendsto_intros, auto)
then show "((λn. extended_Gromov_distance (u n) x) ⤏ 0) F"
by auto
qed
lemma to_Gromov_completion_lim [simp, tendsto_intros]:
"((λn. to_Gromov_completion (u n)) ⤏ to_Gromov_completion a) F ⟷ (u ⤏ a) F"
proof (subst Gromov_completion_inside_limit, auto)
assume "((λn. ereal (dist (u n) a)) ⤏ 0) F"
then have "((λn. real_of_ereal(ereal (dist (u n) a))) ⤏ 0) F"
unfolding zero_ereal_def by (rule lim_real_of_ereal)
then show "(u ⤏ a) F"
by (subst tendsto_dist_iff, auto)
next
assume "(u ⤏ a) F"
then have "((λn. dist (u n) a) ⤏ 0) F"
using tendsto_dist_iff by auto
then show "((λn. ereal (dist (u n) a)) ⤏ 0) F"
unfolding zero_ereal_def by (intro tendsto_intros)
qed
text ‹Now, we can also come back to our original definition of the completion, where points on the
boundary correspond to equivalence classes of sequences whose mutual Gromov product tends to
infinity. We show that this is compatible with our topology: the sequences that are in the equivalence
class of a point on the boundary are exactly the sequences that converge to this point. This is also
a direct consequence of the definitions, although the proof requires some unfolding (and playing
with the hyperbolicity inequality several times).›
text ‹First, we show that a sequence in the equivalence class of $x$ converges to $x$.›
lemma Gromov_completion_converge_to_boundary_aux:
assumes "x ∈ Gromov_boundary" "abs_Gromov_completion v = x" "Gromov_completion_rel v v"
shows "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x) ⇢ ∞"
proof -
have A: "eventually (λn. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x ≥ ereal M) sequentially" for M
proof -
have "Gromov_converging_at_boundary v"
using Gromov_boundary_abs_converging assms by blast
then obtain N where N: "⋀m n. m ≥ N ⟹ n ≥ N ⟹ Gromov_product_at basepoint (v m) (v n) ≥ M + deltaG(TYPE('a))"
unfolding Gromov_converging_at_boundary_def by metis
have "extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x ≥ ereal M" if "n ≥ N" for n
unfolding extended_Gromov_product_at_def proof (rule Inf_greatest, auto)
fix wv wx assume H: "abs_Gromov_completion wv = to_Gromov_completion (v n)"
"x = abs_Gromov_completion wx"
"Gromov_completion_rel wv wv" "Gromov_completion_rel wx wx"
then have wv: "wv p = v n" for p
using Gromov_completion_rel_to_const Quotient3_Gromov_completion Quotient3_rel to_Gromov_completion_def by fastforce
have "Gromov_completion_rel v wx"
using assms H Quotient3_rel[OF Quotient3_Gromov_completion] by auto
then have *: "(λp. Gromov_product_at basepoint (v p) (wx p)) ⇢ ∞"
unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_not_constant' ‹Gromov_converging_at_boundary v› by auto
have "eventually (λp. ereal(Gromov_product_at basepoint (v p) (wx p)) > M + deltaG(TYPE('a))) sequentially"
using order_tendstoD[OF *, of "ereal (M + deltaG TYPE('a))"] by auto
then obtain P where P: "⋀p. p ≥ P ⟹ ereal(Gromov_product_at basepoint (v p) (wx p)) > M + deltaG(TYPE('a))"
unfolding eventually_sequentially by auto
have *: "ereal (Gromov_product_at basepoint (v n) (wx p)) ≥ ereal M" if "p ≥ max P N" for p
proof (intro mono_intros)
have "M ≤ min (M + deltaG(TYPE('a))) (M + deltaG(TYPE('a))) - deltaG(TYPE('a))"
by auto
also have "... ≤ min (Gromov_product_at basepoint (v n) (v p)) (Gromov_product_at basepoint (v p) (wx p)) - deltaG(TYPE('a))"
apply (intro mono_intros)
using N[OF ‹n ≥ N›, of p] ‹p ≥ max P N› P[of p] ‹p ≥ max P N› by auto
also have "... ≤ Gromov_product_at basepoint (v n) (wx p) "
by (rule hyperb_ineq)
finally show "M ≤ Gromov_product_at basepoint (v n) (wx p) "
by simp
qed
then have "eventually (λp. ereal (Gromov_product_at basepoint (v n) (wx p)) ≥ ereal M) sequentially"
unfolding eventually_sequentially by metis
then show "ereal M ≤ liminf (λp. ereal (Gromov_product_at basepoint (wv p) (wx p)))"
unfolding wv by (simp add: Liminf_bounded)
qed
then show ?thesis unfolding eventually_sequentially by auto
qed
have B: "eventually (λn. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x > M) sequentially" if "M < ∞" for M
proof -
obtain N where "ereal N > M" using ‹M < ∞› ereal_dense2 by auto
then have "a ≥ ereal N ⟹ a > M" for a by auto
then show ?thesis using A[of N] eventually_elim2 by force
qed
then show ?thesis
by (rule order_tendstoI, auto)
qed
text ‹Then, we prove the converse and therefore the equivalence.›
lemma Gromov_completion_converge_to_boundary:
assumes "x ∈ Gromov_boundary"
shows "((λn. to_Gromov_completion (u n)) ⇢ x) ⟷ (Gromov_completion_rel u u ∧ abs_Gromov_completion u = x)"
proof
assume "Gromov_completion_rel u u ∧ abs_Gromov_completion u = x"
then show "((λn. to_Gromov_completion(u n)) ⇢ x)"
using Gromov_completion_converge_to_boundary_aux[OF assms, of u] unfolding Gromov_completion_boundary_limit[OF assms] by auto
next
assume H: "(λn. to_Gromov_completion (u n)) ⇢ x"
have Lu: "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x) ⇢ ∞"
using iffD1[OF Gromov_completion_boundary_limit[OF assms] H] by simp
have A: "∃N. ∀n ≥ N. ∀ m ≥ N. Gromov_product_at basepoint (u m) (u n) ≥ M" for M
proof -
have "eventually (λn. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x > M + deltaG(TYPE('a))) sequentially"
by (rule order_tendstoD[OF Lu], auto)
then obtain N where N: "⋀n. n ≥ N ⟹ extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x > M + deltaG(TYPE('a))"
unfolding eventually_sequentially by auto
have "Gromov_product_at basepoint (u m) (u n) ≥ M" if "n ≥ N" "m ≥ N" for m n
proof -
have "ereal M ≤ min (ereal (M + deltaG(TYPE('a)))) (ereal (M + deltaG(TYPE('a)))) - ereal(deltaG(TYPE('a)))"
by simp
also have "... ≤ min (extended_Gromov_product_at basepoint (to_Gromov_completion (u m)) x) (extended_Gromov_product_at basepoint x (to_Gromov_completion (u n))) - deltaG(TYPE('a))"
apply (intro mono_intros) using N[OF ‹n ≥ N›] N[OF ‹m ≥ N›]
by (auto simp add: extended_Gromov_product_at_commute)
also have "... ≤ extended_Gromov_product_at basepoint (to_Gromov_completion (u m)) (to_Gromov_completion (u n))"
by (rule extended_hyperb_ineq)
finally show ?thesis by auto
qed
then show ?thesis by auto
qed
have "∃N. ∀n ≥ N. ∀ m ≥ N. Gromov_product_at a (u m) (u n) ≥ M" for M a
proof -
obtain N where N: "⋀m n. m ≥ N ⟹ n ≥ N ⟹ Gromov_product_at basepoint (u m) (u n) ≥ M + dist a basepoint"
using A[of "M + dist a basepoint"] by auto
have "Gromov_product_at a (u m) (u n) ≥ M" if "m ≥ N" "n ≥ N" for m n
using N[OF that] Gromov_product_at_diff1[of a "u m" "u n" basepoint] by auto
then show ?thesis by auto
qed
then have "Gromov_converging_at_boundary u"
unfolding Gromov_converging_at_boundary_def by auto
then have "Gromov_completion_rel u u" using Gromov_converging_at_boundary_rel by auto
define v where "v = rep_Gromov_completion x"
then have "Gromov_converging_at_boundary v"
using Gromov_boundary_rep_converging[OF assms] by auto
have v: "abs_Gromov_completion v = x" "Gromov_completion_rel v v"
using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion]
unfolding v_def by auto
then have Lv: "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x) ⇢ ∞"
using Gromov_completion_converge_to_boundary_aux[OF assms] by auto
have *: "(λn. min (extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x) (extended_Gromov_product_at basepoint x (to_Gromov_completion (v n))) -
ereal (deltaG TYPE('a))) ⇢ min ∞ ∞ - ereal (deltaG TYPE('a))"
apply (intro tendsto_intros) using Lu Lv by (auto simp add: extended_Gromov_product_at_commute)
have "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) (to_Gromov_completion (v n))) ⇢ ∞"
apply (rule tendsto_sandwich[of "λn. min (extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x)
(extended_Gromov_product_at basepoint x (to_Gromov_completion (v n))) - deltaG(TYPE('a))" _ _ "λ_. ∞"])
using extended_hyperb_ineq not_eventuallyD apply blast using * by auto
then have "(λn. Gromov_product_at basepoint (u n) (v n)) ⇢ ∞"
by auto
then have "(λn. Gromov_product_at a (u n) (v n)) ⇢ ∞" for a
using Gromov_product_tendsto_PInf_a_b by auto
then have "Gromov_completion_rel u v"
unfolding Gromov_completion_rel_def
using ‹Gromov_converging_at_boundary u› ‹Gromov_converging_at_boundary v› by auto
then have "abs_Gromov_completion u = abs_Gromov_completion v"
using Quotient3_rel[OF Quotient3_Gromov_completion] v(2) ‹Gromov_completion_rel u u› by auto
then have "abs_Gromov_completion u = x"
using v(1) by auto
then show "Gromov_completion_rel u u ∧ abs_Gromov_completion u = x"
using ‹Gromov_completion_rel u u› by auto
qed
text ‹In particular, it follows that a sequence which is \verb+Gromov_converging_at_boundary+ is
indeed converging to a point on the boundary, the equivalence class of this sequence.›
lemma Gromov_converging_at_boundary_converges:
assumes "Gromov_converging_at_boundary u"
shows "∃x ∈ Gromov_boundary. (λn. to_Gromov_completion (u n)) ⇢ x"
apply (rule bexI[of _ "abs_Gromov_completion u"])
apply (subst Gromov_completion_converge_to_boundary)
using assms by (auto simp add: Gromov_converging_at_boundary_rel)
lemma Gromov_converging_at_boundary_converges':
assumes "Gromov_converging_at_boundary u"
shows "convergent (λn. to_Gromov_completion (u n))"
unfolding convergent_def using Gromov_converging_at_boundary_converges[OF assms] by auto
lemma lim_imp_Gromov_converging_at_boundary:
fixes u::"nat ⇒ 'a::Gromov_hyperbolic_space"
assumes "(λn. to_Gromov_completion (u n)) ⇢ x" "x ∈ Gromov_boundary"
shows "Gromov_converging_at_boundary u"
using Gromov_boundary_abs_converging Gromov_completion_converge_to_boundary assms by blast
text ‹If two sequences tend to the same point at infinity, then their Gromov product tends to
infinity.›
lemma same_limit_imp_Gromov_product_tendsto_infinity:
assumes "z ∈ Gromov_boundary"
"(λn. to_Gromov_completion (u n)) ⇢ z"
"(λn. to_Gromov_completion (v n)) ⇢ z"
shows "∃N. ∀n ≥ N. ∀m ≥ N. Gromov_product_at a (u n) (v m) ≥ C"
proof -
have "Gromov_completion_rel u u" "Gromov_completion_rel v v" "abs_Gromov_completion u = abs_Gromov_completion v"
using iffD1[OF Gromov_completion_converge_to_boundary[OF assms(1)]] assms by auto
then have *: "Gromov_completion_rel u v"
using Quotient3_Gromov_completion Quotient3_rel by fastforce
have **: "Gromov_converging_at_boundary u"
using assms lim_imp_Gromov_converging_at_boundary by blast
then obtain M where M: "⋀m n. m ≥ M ⟹ n ≥ M ⟹ Gromov_product_at a (u m) (u n) ≥ C + deltaG(TYPE('a))"
unfolding Gromov_converging_at_boundary_def by blast
have "(λn. Gromov_product_at a (u n) (v n)) ⇢ ∞"
using * Gromov_converging_at_boundary_imp_not_constant'[OF **] unfolding Gromov_completion_rel_def by auto
then have "eventually (λn. Gromov_product_at a (u n) (v n) ≥ C + deltaG(TYPE('a))) sequentially"
by (meson Lim_PInfty ereal_less_eq(3) eventually_sequentiallyI)
then obtain N where N: "⋀n. n ≥ N ⟹ Gromov_product_at a (u n) (v n) ≥ C + deltaG(TYPE('a))"
unfolding eventually_sequentially by auto
have "Gromov_product_at a (u n) (v m) ≥ C" if "n ≥ max M N" "m ≥ max M N" for m n
proof -
have "C + deltaG(TYPE('a)) ≤ min (Gromov_product_at a (u n) (u m)) (Gromov_product_at a (u m) (v m))"
using M N that by auto
also have "... ≤ Gromov_product_at a (u n) (v m) + deltaG(TYPE('a))"
by (intro mono_intros)
finally show ?thesis by simp
qed
then show ?thesis
by blast
qed
text ‹An admissible sequence converges in the Gromov boundary, to the point it defines. This
follows from the definition of the topology in the two cases, inner and boundary.›
lemma abs_Gromov_completion_limit:
assumes "Gromov_completion_rel u u"
shows "(λn. to_Gromov_completion (u n)) ⇢ abs_Gromov_completion u"
proof (cases "abs_Gromov_completion u")
case (to_Gromov_completion x)
then show ?thesis
using Gromov_completion_rel_to_const Quotient3_Gromov_completion Quotient3_rel assms to_Gromov_completion_def by fastforce
next
case boundary
show ?thesis
unfolding Gromov_completion_converge_to_boundary[OF boundary]
using assms Gromov_boundary_rep_converging Gromov_converging_at_boundary_rel Quotient3_Gromov_completion Quotient3_abs_rep boundary by fastforce
qed
text ‹In particular, a point in the Gromov boundary is the limit of
its representative sequence in the space.›
lemma rep_Gromov_completion_limit:
"(λn. to_Gromov_completion (rep_Gromov_completion x n)) ⇢ x"
using abs_Gromov_completion_limit[of "rep_Gromov_completion x"] Quotient3_Gromov_completion Quotient3_abs_rep Quotient3_rep_reflp by fastforce
subsection ‹Continuity properties of the extended Gromov product and distance›
text ‹We have defined our extended Gromov product in terms of sequences satisfying the equivalence
relation. However, we would like to avoid this definition as much as possible, and express things
in terms of the topology of the space. Hence, we reformulate this definition in topological terms,
first when one of the two points is inside and the other one is on the boundary, then for all
cases, and then we come back to the case where one point is inside, removing the assumption that
the other one is on the boundary.›
lemma extended_Gromov_product_inside_boundary_aux:
assumes "y ∈ Gromov_boundary"
shows "extended_Gromov_product_at e (to_Gromov_completion x) y = Inf {liminf (λn. ereal(Gromov_product_at e x (v n))) |v. (λn. to_Gromov_completion (v n)) ⇢ y}"
proof -
have A: "abs_Gromov_completion v = to_Gromov_completion x ∧ Gromov_completion_rel v v ⟷ (v = (λn. x))" for v
apply (auto simp add: to_Gromov_completion_def)
by (metis (mono_tags) Gromov_completion_rel_def Quotient3_Gromov_completion abs_Gromov_completion_in_Gromov_boundary not_in_Gromov_boundary' rep_Gromov_completion_to_Gromov_completion rep_abs_rsp to_Gromov_completion_def)
have *: "{F u v |u v. abs_Gromov_completion u = to_Gromov_completion x ∧ abs_Gromov_completion v = y ∧ Gromov_completion_rel u u ∧ Gromov_completion_rel v v}
= {F (λn. x) v |v. (λn. to_Gromov_completion (v n)) ⇢ y}" for F::"(nat ⇒ 'a) ⇒ (nat ⇒ 'a) ⇒ ereal"
unfolding Gromov_completion_converge_to_boundary[OF ‹y ∈ Gromov_boundary›] using A by force
show ?thesis
unfolding extended_Gromov_product_at_def * by simp
qed
lemma extended_Gromov_product_boundary_inside_aux:
assumes "y ∈ Gromov_boundary"
shows "extended_Gromov_product_at e y (to_Gromov_completion x) = Inf {liminf (λn. ereal(Gromov_product_at e (v n) x)) |v. (λn. to_Gromov_completion (v n)) ⇢ y}"
using extended_Gromov_product_inside_boundary_aux[OF assms] by (simp add: extended_Gromov_product_at_commute Gromov_product_commute)
lemma extended_Gromov_product_at_topological:
"extended_Gromov_product_at e x y = Inf {liminf (λn. ereal(Gromov_product_at e (u n) (v n))) |u v. (λn. to_Gromov_completion (u n)) ⇢ x ∧ (λn. to_Gromov_completion (v n)) ⇢ y}"
proof (cases x)
case boundary
show ?thesis
proof (cases y)
case boundary
then show ?thesis
unfolding extended_Gromov_product_at_def Gromov_completion_converge_to_boundary[OF ‹x ∈ Gromov_boundary›] Gromov_completion_converge_to_boundary[OF ‹y ∈ Gromov_boundary›]
by meson
next
case (to_Gromov_completion yi)
have A: "liminf (λn. ereal (Gromov_product_at e (u n) (v n))) = liminf (λn. ereal (Gromov_product_at e (u n) yi))" if "v ⇢ yi" for u v
proof -
define h where "h = (λn. Gromov_product_at e (u n) (v n) - Gromov_product_at e (u n) yi)"
have h: "h ⇢ 0"
apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "λn. 0" _ _ "λn. dist (v n) yi"])
unfolding h_def using Gromov_product_at_diff3[of e _ _ yi] that apply auto
using tendsto_dist_iff by blast
have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e (u n) yi)" for n
unfolding h_def by auto
have "liminf (λn. ereal (Gromov_product_at e (u n) (v n))) = 0 + liminf (λn. ereal (Gromov_product_at e (u n) yi))"
unfolding * apply (rule ereal_liminf_lim_add) using h by (auto simp add: zero_ereal_def)
then show ?thesis by simp
qed
show ?thesis
unfolding to_Gromov_completion extended_Gromov_product_boundary_inside_aux[OF ‹x ∈ Gromov_boundary›] apply (rule cong[of Inf Inf], auto)
using A by fast+
qed
next
case (to_Gromov_completion xi)
show ?thesis
proof (cases y)
case boundary
have A: "liminf (λn. ereal (Gromov_product_at e (u n) (v n))) = liminf (λn. ereal (Gromov_product_at e xi (v n)))" if "u ⇢ xi" for u v
proof -
define h where "h = (λn. Gromov_product_at e (u n) (v n) - Gromov_product_at e xi (v n))"
have h: "h ⇢ 0"
apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "λn. 0" _ _ "λn. dist (u n) xi"])
unfolding h_def using Gromov_product_at_diff2[of e _ _ xi] that apply auto
using tendsto_dist_iff by blast
have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e xi (v n))" for n
unfolding h_def by auto
have "liminf (λn. ereal (Gromov_product_at e (u n) (v n))) = 0 + liminf (λn. ereal (Gromov_product_at e xi (v n)))"
unfolding * apply (rule ereal_liminf_lim_add) using h by (auto simp add: zero_ereal_def)
then show ?thesis by simp
qed
show ?thesis
unfolding to_Gromov_completion extended_Gromov_product_inside_boundary_aux[OF ‹y ∈ Gromov_boundary›] apply (rule cong[of Inf Inf], auto)
using A by fast+
next
case (to_Gromov_completion yi)
have B: "liminf (λn. Gromov_product_at e (u n) (v n)) = Gromov_product_at e xi yi" if "u ⇢ xi" "v ⇢ yi" for u v
proof -
have "(λn. Gromov_product_at e (u n) (v n)) ⇢ Gromov_product_at e xi yi"
apply (rule Gromov_product_at_continuous) using that by auto
then show "liminf (λn. Gromov_product_at e (u n) (v n)) = Gromov_product_at e xi yi"
by (simp add: lim_imp_Liminf)
qed
have *: "{liminf (λn. ereal (Gromov_product_at e (u n) (v n))) |u v. u ⇢ xi ∧ v ⇢ yi} = {ereal (Gromov_product_at e xi yi)}"
using B apply auto by (rule exI[of _ "λn. xi"], rule exI[of _ "λn. yi"], auto)
show ?thesis
unfolding ‹x = to_Gromov_completion xi› ‹y = to_Gromov_completion yi› by (auto simp add: *)
qed
qed
lemma extended_Gromov_product_inside_boundary:
"extended_Gromov_product_at e (to_Gromov_completion x) y = Inf {liminf (λn. ereal(Gromov_product_at e x (v n))) |v. (λn. to_Gromov_completion (v n)) ⇢ y}"
proof -
have A: "liminf (λn. ereal (Gromov_product_at e (u n) (v n))) = liminf (λn. ereal (Gromov_product_at e x (v n)))" if "u ⇢ x" for u v
proof -
define h where "h = (λn. Gromov_product_at e (u n) (v n) - Gromov_product_at e x (v n))"
have h: "h ⇢ 0"
apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "λn. 0" _ _ "λn. dist (u n) x"])
unfolding h_def using Gromov_product_at_diff2[of e _ _ x] that apply auto
using tendsto_dist_iff by blast
have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e x (v n))" for n
unfolding h_def by auto
have "liminf (λn. ereal (Gromov_product_at e (u n) (v n))) = 0 + liminf (λn. ereal (Gromov_product_at e x (v n)))"
unfolding * apply (rule ereal_liminf_lim_add) using h by (auto simp add: zero_ereal_def)
then show ?thesis by simp
qed
show ?thesis
unfolding extended_Gromov_product_at_topological apply (rule cong[of Inf Inf], auto)
using A by fast+
qed
lemma extended_Gromov_product_boundary_inside:
"extended_Gromov_product_at e y (to_Gromov_completion x) = Inf {liminf (λn. ereal(Gromov_product_at e (v n) x)) |v. (λn. to_Gromov_completion (v n)) ⇢ y}"
using extended_Gromov_product_inside_boundary by (simp add: extended_Gromov_product_at_commute Gromov_product_commute)
text ‹Now, we compare the extended Gromov product to a sequence of Gromov products for converging
sequences. As the extended Gromov product is defined as an Inf of limings, it is clearly smaller
than the liminf. More interestingly, it is also of the order of magnitude of the limsup, for
whatever sequence one uses. In other words, it is canonically defined, up to $2 \delta$.›
lemma extended_Gromov_product_le_liminf:
assumes "(λn. to_Gromov_completion (u n)) ⇢ xi"
"(λn. to_Gromov_completion (v n)) ⇢ eta"
shows "liminf (λn. Gromov_product_at e (u n) (v n)) ≥ extended_Gromov_product_at e xi eta"
unfolding extended_Gromov_product_at_topological using assms by (auto intro!: Inf_lower)
lemma limsup_le_extended_Gromov_product_inside:
assumes "(λn. to_Gromov_completion (v n)) ⇢ (eta::('a::Gromov_hyperbolic_space) Gromov_completion)"
shows "limsup (λn. Gromov_product_at e x (v n)) ≤ extended_Gromov_product_at e (to_Gromov_completion x) eta + deltaG(TYPE('a))"
proof (cases eta)
case boundary
have A: "limsup (λn. Gromov_product_at e x (v n)) ≤ liminf (λn. Gromov_product_at e x (v' n)) + deltaG(TYPE('a))"
if H: "(λn. to_Gromov_completion (v' n)) ⇢ eta" for v'
proof -
have "ereal a ≤ liminf (λn. Gromov_product_at e x (v' n)) + deltaG(TYPE('a))" if L: "ereal a < limsup (λn. Gromov_product_at e x (v n))" for a
proof -
obtain Nv where Nv: "⋀m n. m ≥ Nv ⟹ n ≥ Nv ⟹ Gromov_product_at e (v m) (v' n) ≥ a"
using same_limit_imp_Gromov_product_tendsto_infinity[OF ‹eta ∈ Gromov_boundary› assms H] by blast
obtain N where N: "ereal a < Gromov_product_at e x (v N)" "N ≥ Nv"
using limsup_obtain[OF L] by blast
have *: "a - deltaG(TYPE('a)) ≤ Gromov_product_at e x (v' n)" if "n ≥ Nv" for n
proof -
have "a ≤ min (Gromov_product_at e x (v N)) (Gromov_product_at e (v N) (v' n))"
apply auto using N(1) Nv[OF ‹N ≥ Nv› ‹n ≥ Nv›] by auto
also have "... ≤ Gromov_product_at e x (v' n) + deltaG(TYPE('a))"
by (intro mono_intros)
finally show ?thesis by auto
qed
have "a - deltaG(TYPE('a)) ≤ liminf (λn. Gromov_product_at e x (v' n))"
apply (rule Liminf_bounded) unfolding eventually_sequentially using * by fastforce
then show ?thesis
unfolding ereal_minus(1)[symmetric] by (subst ereal_minus_le[symmetric], auto)
qed
then show ?thesis
using ereal_dense2 not_less by blast
qed
have "limsup (λn. Gromov_product_at e x (v n)) - deltaG(TYPE('a)) ≤ extended_Gromov_product_at e (to_Gromov_completion x) eta"
unfolding extended_Gromov_product_inside_boundary by (rule Inf_greatest, auto simp add: A)
then show ?thesis by auto
next
case (to_Gromov_completion y)
then have "v ⇢ y" using assms by auto
have L: "(λn. Gromov_product_at e x (v n)) ⇢ ereal(Gromov_product_at e x y)"
using Gromov_product_at_continuous[OF _ _ ‹v ⇢ y›, of "λn. e" e "λn. x" x] by auto
show ?thesis
unfolding to_Gromov_completion using lim_imp_Limsup[OF _ L] by auto
qed
lemma limsup_le_extended_Gromov_product_inside':
assumes "(λn. to_Gromov_completion (v n)) ⇢ (eta::('a::Gromov_hyperbolic_space) Gromov_completion)"
shows "limsup (λn. Gromov_product_at e (v n) x) ≤ extended_Gromov_product_at e eta (to_Gromov_completion x) + deltaG(TYPE('a))"
using limsup_le_extended_Gromov_product_inside[OF assms] by (simp add: Gromov_product_commute extended_Gromov_product_at_commute)
lemma limsup_le_extended_Gromov_product:
assumes "(λn. to_Gromov_completion (u n)) ⇢ (xi::('a::Gromov_hyperbolic_space) Gromov_completion)"
"(λn. to_Gromov_completion (v n)) ⇢ eta"
shows "limsup (λn. Gromov_product_at e (u n) (v n)) ≤ extended_Gromov_product_at e xi eta + 2 * deltaG(TYPE('a))"
proof -
consider "xi ∈ Gromov_boundary ∧ eta ∈ Gromov_boundary" | "xi ∉ Gromov_boundary" | "eta ∉ Gromov_boundary"
by blast
then show ?thesis
proof (cases)
case 1
then have B: "xi ∈ Gromov_boundary" "eta ∈ Gromov_boundary" by auto
have A: "limsup (λn. Gromov_product_at e (u n) (v n)) ≤ liminf (λn. Gromov_product_at e (u' n) (v' n)) + 2 * deltaG(TYPE('a))"
if H: "(λn. to_Gromov_completion (u' n)) ⇢ xi" "(λn. to_Gromov_completion (v' n)) ⇢ eta" for u' v'
proof -
have "ereal a ≤ liminf (λn. Gromov_product_at e (u' n) (v' n)) + 2 * deltaG(TYPE('a))" if L: "ereal a < limsup (λn. Gromov_product_at e (u n) (v n))" for a
proof -
obtain Nu where Nu: "⋀m n. m ≥ Nu ⟹ n ≥ Nu ⟹ Gromov_product_at e (u' m) (u n) ≥ a"
using same_limit_imp_Gromov_product_tendsto_infinity[OF ‹xi ∈ Gromov_boundary› H(1) assms(1)] by blast
obtain Nv where Nv: "⋀m n. m ≥ Nv ⟹ n ≥ Nv ⟹ Gromov_product_at e (v m) (v' n) ≥ a"
using same_limit_imp_Gromov_product_tendsto_infinity[OF ‹eta ∈ Gromov_boundary› assms(2) H(2)] by blast
obtain N where N: "ereal a < Gromov_product_at e (u N) (v N)" "N ≥ max Nu Nv"
using limsup_obtain[OF L] by blast
then have "N ≥ Nu" "N ≥ Nv" by auto
have *: "a - 2 * deltaG(TYPE('a)) ≤ Gromov_product_at e (u' n) (v' n)" if "n ≥ max Nu Nv" for n
proof -
have n: "n ≥ Nu" "n ≥ Nv" using that by auto
have "a ≤ Min {Gromov_product_at e (u' n) (u N), Gromov_product_at e (u N) (v N), Gromov_product_at e (v N) (v' n)}"
apply auto using N(1) Nu[OF n(1) ‹N ≥ Nu›] Nv[OF ‹N ≥ Nv› n(2)] by auto
also have "... ≤ Gromov_product_at e (u' n) (v' n) + 2 * deltaG(TYPE('a))"
by (intro mono_intros)
finally show ?thesis by auto
qed
have "a - 2 * deltaG(TYPE('a)) ≤ liminf (λn. Gromov_product_at e (u' n) (v' n))"
apply (rule Liminf_bounded) unfolding eventually_sequentially using * by fastforce
then show ?thesis
unfolding ereal_minus(1)[symmetric] by (subst ereal_minus_le[symmetric], auto)
qed
then show ?thesis
using ereal_dense2 not_less by blast
qed
have "limsup (λn. Gromov_product_at e (u n) (v n)) - 2 * deltaG(TYPE('a)) ≤ extended_Gromov_product_at e xi eta"
unfolding extended_Gromov_product_at_topological by (rule Inf_greatest, auto simp add: A)
then show ?thesis by auto
next
case 2
then obtain x where x: "xi = to_Gromov_completion x" by (cases xi, auto)
have A: "limsup (λn. ereal (Gromov_product_at e (u n) (v n))) = limsup (λn. ereal (Gromov_product_at e x (v n)))"
proof -
define h where "h = (λn. Gromov_product_at e (u n) (v n) - Gromov_product_at e x (v n))"
have h: "h ⇢ 0"
apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "λn. 0" _ _ "λn. dist (u n) x"])
unfolding h_def using Gromov_product_at_diff2[of e _ _ x] assms(1) unfolding x apply auto
using tendsto_dist_iff by blast
have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e x (v n))" for n
unfolding h_def by auto
have "limsup (λn. ereal (Gromov_product_at e (u n) (v n))) = 0 + limsup (λn. ereal (Gromov_product_at e x (v n)))"
unfolding * apply (rule ereal_limsup_lim_add) using h by (auto simp add: zero_ereal_def)
then show ?thesis by simp
qed
have *: "ereal (deltaG TYPE('a)) ≤ ereal (2 * deltaG TYPE('a))"
by auto
show ?thesis
unfolding A x using limsup_le_extended_Gromov_product_inside[OF assms(2), of e x] *
by (meson add_left_mono order.trans)
next
case 3
then obtain y where y: "eta = to_Gromov_completion y" by (cases eta, auto)
have A: "limsup (λn. ereal (Gromov_product_at e (u n) (v n))) = limsup (λn. ereal (Gromov_product_at e (u n) y))"
proof -
define h where "h = (λn. Gromov_product_at e (u n) (v n) - Gromov_product_at e (u n) y)"
have h: "h ⇢ 0"
apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "λn. 0" _ _ "λn. dist (v n) y"])
unfolding h_def using Gromov_product_at_diff3[of e _ _ y] assms(2) unfolding y apply auto
using tendsto_dist_iff by blast
have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e (u n) y)" for n
unfolding h_def by auto
have "limsup (λn. ereal (Gromov_product_at e (u n) (v n))) = 0 + limsup (λn. ereal (Gromov_product_at e (u n) y))"
unfolding * apply (rule ereal_limsup_lim_add) using h by (auto simp add: zero_ereal_def)
then show ?thesis by simp
qed
have *: "ereal (deltaG TYPE('a)) ≤ ereal (2 * deltaG TYPE('a))"
by auto
show ?thesis
unfolding A y using limsup_le_extended_Gromov_product_inside'[OF assms(1), of e y] *
by (meson add_left_mono order.trans)
qed
qed
text ‹One can then extend to the boundary the fact that $(y,z)_x + (x,z)_y = d(x,y)$, up to a
constant $\delta$, by taking this identity inside and passing to the limit.›
lemma extended_Gromov_product_add_le:
"extended_Gromov_product_at x xi (to_Gromov_completion y) + extended_Gromov_product_at y xi (to_Gromov_completion x) ≤ dist x y"
proof -
obtain u where u: "(λn. to_Gromov_completion (u n)) ⇢ xi"
using rep_Gromov_completion_limit by blast
have "liminf (λn. ereal (Gromov_product_at a b (u n))) ≥ 0" for a b
by (rule Liminf_bounded[OF always_eventually], auto)
then have *: "liminf (λn. ereal (Gromov_product_at a b (u n))) ≠ -∞" for a b
by auto
have "extended_Gromov_product_at x xi (to_Gromov_completion y) + extended_Gromov_product_at y xi (to_Gromov_completion x)
≤ liminf (λn. ereal (Gromov_product_at x y (u n))) + liminf (λn. Gromov_product_at y x (u n))"
apply (intro mono_intros)
using extended_Gromov_product_le_liminf [OF u, of "λn. y" "to_Gromov_completion y" x]
extended_Gromov_product_le_liminf [OF u, of "λn. x" "to_Gromov_completion x" y] by (auto simp add: Gromov_product_commute)
also have "... ≤ liminf (λn. ereal (Gromov_product_at x y (u n)) + Gromov_product_at y x (u n))"
by (rule ereal_liminf_add_mono, auto simp add: *)
also have "... = dist x y"
apply (simp add: Gromov_product_add)
by (metis lim_imp_Liminf sequentially_bot tendsto_const)
finally show ?thesis by auto
qed
lemma extended_Gromov_product_add_ge:
"extended_Gromov_product_at (x::'a::Gromov_hyperbolic_space) xi (to_Gromov_completion y) + extended_Gromov_product_at y xi (to_Gromov_completion x) ≥ dist x y - deltaG(TYPE('a))"
proof -
have A: "dist x y - extended_Gromov_product_at y (to_Gromov_completion x) xi - deltaG(TYPE('a)) ≤ liminf (λn. ereal (Gromov_product_at x y (u n)))"
if "(λn. to_Gromov_completion (u n)) ⇢ xi" for u
proof -
have "dist x y = liminf (λn. ereal (Gromov_product_at x y (u n)) + Gromov_product_at y x (u n))"
apply (simp add: Gromov_product_add)
by (metis lim_imp_Liminf sequentially_bot tendsto_const)
also have "... ≤ liminf (λn. ereal (Gromov_product_at x y (u n))) + limsup (λn. Gromov_product_at y x (u n))"
by (rule ereal_liminf_limsup_add)
also have "... ≤ liminf (λn. ereal (Gromov_product_at x y (u n))) + (extended_Gromov_product_at y (to_Gromov_completion x) xi + deltaG(TYPE('a)))"
by (intro mono_intros limsup_le_extended_Gromov_product_inside[OF that])
finally show ?thesis by (auto simp add: algebra_simps)
qed
have "dist x y - extended_Gromov_product_at y (to_Gromov_completion x) xi - deltaG(TYPE('a)) ≤ extended_Gromov_product_at x (to_Gromov_completion y) xi"
unfolding extended_Gromov_product_inside_boundary[of x] apply (rule Inf_greatest) using A by auto
then show ?thesis
apply (auto simp add: algebra_simps extended_Gromov_product_at_commute)
unfolding ereal_minus(1)[symmetric] by (subst ereal_minus_le, auto simp add: algebra_simps)
qed
text ‹If one perturbs a sequence inside the space by a bounded distance, one does not change the
limit on the boundary.›
lemma Gromov_converging_at_boundary_bounded_perturbation:
assumes "(λn. to_Gromov_completion (u n)) ⇢ x"
"x ∈ Gromov_boundary"
"⋀n. dist (u n) (v n) ≤ C"
shows "(λn. to_Gromov_completion (v n)) ⇢ x"
proof -
have "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x) ⇢ ∞"
proof (rule tendsto_sandwich[of "λn. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x - C" _ _ "λn. ∞"])
show "∀⇩F n in sequentially. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x - ereal C ≤ extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x"
proof (rule always_eventually, auto)
fix n::nat
have "extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x ≤ extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x
+ extended_Gromov_distance (to_Gromov_completion (u n)) (to_Gromov_completion (v n))"
by (intro mono_intros)
also have "... ≤ extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x + C"
using assms(3)[of n] by (intro mono_intros, auto)
finally show "extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x ≤ extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x + ereal C"
by auto
qed
have "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x - ereal C) ⇢ ∞ - ereal C"
apply (intro tendsto_intros)
unfolding Gromov_completion_boundary_limit[OF ‹x ∈ Gromov_boundary›, symmetric] using assms(1) by auto
then show "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x - ereal C) ⇢ ∞"
by auto
qed (auto)
then show ?thesis
unfolding Gromov_completion_boundary_limit[OF ‹x ∈ Gromov_boundary›] by simp
qed
text ‹We prove that the extended Gromov distance is a continuous function of one variable,
by separating the different cases at infinity and inside the space. Note that it is not a
continuous function of both variables: if $u_n$ is inside the space but tends to a point $x$ in the
boundary, then the extended Gromov distance between $u_n$ and $u_n$ is $0$, but for the limit it is
$\infty$.›
lemma extended_Gromov_distance_continuous:
"continuous_on UNIV (λy. extended_Gromov_distance x y)"
proof (cases x)
text ‹First, if $x$ is in the boundary, then all distances to $x$ are infinite, and the statement
is trivial.›
case boundary
then have *: "extended_Gromov_distance x y = ∞" for y
by auto
show ?thesis
unfolding * using continuous_on_topological by blast
next
text ‹Next, consider the case where $x$ is inside the space. We split according to whether $y$ is
inside the space or at infinity.›
case (to_Gromov_completion a)
have "(λn. extended_Gromov_distance x (u n)) ⇢ extended_Gromov_distance x y" if "u ⇢ y" for u y
proof (cases y)
text ‹If $y$ is at infinity, then we know that the Gromov product of $u_n$ and $y$ tends to
infinity. Therefore, the extended distance from $u_n$ to any fixed point also tends to infinity
(as the Gromov product is bounded from below by the extended distance).›
case boundary
have *: "(λn. extended_Gromov_product_at a (u n) y) ⇢ ∞"
by (rule extended_Gromov_product_tendsto_PInf_a_b[OF iffD1[OF Gromov_completion_boundary_limit, OF boundary ‹u ⇢ y›]])
have "(λn. extended_Gromov_distance x (u n)) ⇢ ∞"
apply (rule tendsto_sandwich[of "λn. extended_Gromov_product_at a (u n) y" _ _ "λ_. ∞"])
unfolding to_Gromov_completion using extended_Gromov_product_le_dist[of a "u _" y] * by auto
then show ?thesis using boundary by auto
next
text ‹If $y$ is inside the space, then we use the triangular inequality for the extended Gromov
distance to conclure.›
case (to_Gromov_completion b)
then have F: "y ∉ Gromov_boundary" by auto
have *: "(λn. extended_Gromov_distance (u n) y) ⇢ 0"
by (rule iffD1[OF Gromov_completion_inside_limit[OF F] ‹u ⇢ y›])
show "(λn. extended_Gromov_distance x (u n)) ⇢ extended_Gromov_distance x y"
proof (rule tendsto_sandwich[of "λn. extended_Gromov_distance x y - extended_Gromov_distance (u n) y" _ _
"λn. extended_Gromov_distance x y + extended_Gromov_distance (u n) y"])
have "extended_Gromov_distance x y - extended_Gromov_distance (u n) y ≤ extended_Gromov_distance x (u n)" for n
using extended_Gromov_distance_triangle[of y x "u n"]
by (auto simp add: extended_Gromov_distance_commute F ennreal_minus_le_iff extended_Gromov_distance_def)
then show "∀⇩F n in sequentially. extended_Gromov_distance x y - extended_Gromov_distance (u n) y ≤ extended_Gromov_distance x (u n)"
by auto
have "extended_Gromov_distance x (u n) ≤ extended_Gromov_distance x y + extended_Gromov_distance (u n) y" for n
using extended_Gromov_distance_triangle[of x "u n" y] by (auto simp add: extended_Gromov_distance_commute)
then show "∀⇩F n in sequentially. extended_Gromov_distance x (u n) ≤ extended_Gromov_distance x y + extended_Gromov_distance (u n) y"
by auto
have "(λn. extended_Gromov_distance x y - extended_Gromov_distance (u n) y) ⇢ extended_Gromov_distance x y - 0"
by (intro tendsto_intros *, auto)
then show "(λn. extended_Gromov_distance x y - extended_Gromov_distance (u n) y) ⇢ extended_Gromov_distance x y"
by simp
have "(λn. extended_Gromov_distance x y + extended_Gromov_distance (u n) y) ⇢ extended_Gromov_distance x y + 0"
by (intro tendsto_intros *, auto)
then show "(λn. extended_Gromov_distance x y + extended_Gromov_distance (u n) y) ⇢ extended_Gromov_distance x y"
by simp
qed
qed
then show ?thesis
unfolding continuous_on_sequentially comp_def by auto
qed
lemma extended_Gromov_distance_continuous':
"continuous_on UNIV (λx. extended_Gromov_distance x y)"
using extended_Gromov_distance_continuous[of y] extended_Gromov_distance_commute[of _ y] by auto
subsection ‹Topology of the Gromov boundary›
text ‹We deduce the basic fact that the original space is open in the Gromov completion from the
continuity of the extended distance.›
lemma to_Gromov_completion_range_open:
"open (range to_Gromov_completion)"
proof -
have *: "range to_Gromov_completion = (λx. extended_Gromov_distance (to_Gromov_completion basepoint) x)-`{..<∞}"
using Gromov_boundary_def extended_Gromov_distance_PInf_boundary(2) by fastforce
show ?thesis
unfolding * using extended_Gromov_distance_continuous open_lessThan open_vimage by blast
qed
lemma Gromov_boundary_closed:
"closed Gromov_boundary"
unfolding Gromov_boundary_def using to_Gromov_completion_range_open by auto
text ‹The original space is also dense in its Gromov completion, as all points at infinity are
by definition limits of some sequence in the space.›
lemma to_Gromov_completion_range_dense [simp]:
"closure (range to_Gromov_completion) = UNIV"
apply (auto simp add: closure_sequential) using rep_Gromov_completion_limit by force
lemma to_Gromov_completion_homeomorphism:
"homeomorphism_on UNIV to_Gromov_completion"
by (rule homeomorphism_on_sequentially, auto)
lemma to_Gromov_completion_continuous:
"continuous_on UNIV to_Gromov_completion"
by (rule homeomorphism_on_continuous[OF to_Gromov_completion_homeomorphism])
lemma from_Gromov_completion_continuous:
"homeomorphism_on (range to_Gromov_completion) from_Gromov_completion"
"continuous_on (range to_Gromov_completion) from_Gromov_completion"
"⋀x::('a::Gromov_hyperbolic_space) Gromov_completion. x ∈ range to_Gromov_completion ⟹ continuous (at x) from_Gromov_completion"
proof -
show *: "homeomorphism_on (range to_Gromov_completion) from_Gromov_completion"
using homeomorphism_on_inverse[OF to_Gromov_completion_homeomorphism] unfolding from_Gromov_completion_def[symmetric] by simp
show "continuous_on (range to_Gromov_completion) from_Gromov_completion"
by (simp add: * homeomorphism_on_continuous)
then show "continuous (at x) from_Gromov_completion" if "x ∈ range to_Gromov_completion" for x::"'a Gromov_completion"
using continuous_on_eq_continuous_at that to_Gromov_completion_range_open by auto
qed
text ‹The Gromov boundary is always complete. Indeed, consider a Cauchy sequence $u_n$ in the
boundary, and approximate well enough $u_n$ by a point $v_n$ inside. Then the sequence $v_n$
is Gromov converging at infinity (the respective Gromov products tend to infinity essentially
by definition), and its limit point is the limit of the original sequence $u$.›
proposition Gromov_boundary_complete:
"complete Gromov_boundary"
proof (rule completeI)
fix u::"nat ⇒ 'a Gromov_completion" assume "∀n. u n ∈ Gromov_boundary" "Cauchy u"
then have u: "⋀n. u n ∈ Gromov_boundary" by auto
have *: "∃x ∈ range to_Gromov_completion. dist (u n) x < 1/real(n+1)" for n
by (rule closure_approachableD, auto simp add: to_Gromov_completion_range_dense)
have "∃v. ∀n. dist (to_Gromov_completion (v n)) (u n) < 1/real(n+1)"
using of_nat_less_top apply (intro choice) using * by (auto simp add: dist_commute)
then obtain v where v: "⋀n. dist (to_Gromov_completion (v n)) (u n) < 1/real(n+1)"
by blast
have "(λn. dist (to_Gromov_completion (v n)) (u n)) ⇢ 0"
apply (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. 1/real(n+1)"])
using v LIMSEQ_ignore_initial_segment[OF lim_1_over_n, of 1] unfolding eventually_sequentially
by (auto simp add: less_imp_le)
have "Gromov_converging_at_boundary v"
proof (rule Gromov_converging_at_boundaryI[of basepoint])
fix M::real
obtain D1 e1 where D1: "e1 > 0" "D1 < ∞" "⋀x y::'a Gromov_completion. dist x y ≤ e1 ⟹ extended_Gromov_distance x (to_Gromov_completion basepoint) ≥ D1 ⟹ extended_Gromov_product_at basepoint x y ≥ ereal M"
using large_Gromov_product_approx[of "ereal M"] by auto
obtain D2 e2 where D2: "e2 > 0" "D2 < ∞" "⋀x y::'a Gromov_completion. dist x y ≤ e2 ⟹ extended_Gromov_distance x (to_Gromov_completion basepoint) ≥ D2 ⟹ extended_Gromov_product_at basepoint x y ≥ D1"
using large_Gromov_product_approx[OF ‹D1 < ∞›] by auto
define e where "e = (min e1 e2)/3"
have "e > 0" unfolding e_def using ‹e1 > 0› ‹e2 > 0› by auto
then obtain N1 where N1: "⋀n m. n ≥ N1 ⟹ m ≥ N1 ⟹ dist (u n) (u m) < e"
using ‹Cauchy u› unfolding Cauchy_def by blast
have "eventually (λn. dist (to_Gromov_completion (v n)) (u n) < e) sequentially"
by (rule order_tendstoD[OF ‹(λn. dist (to_Gromov_completion (v n)) (u n)) ⇢ 0›], fact)
then obtain N2 where N2: "⋀n. n ≥ N2 ⟹ dist (to_Gromov_completion (v n)) (u n) < e"
unfolding eventually_sequentially by auto
have "ereal M ≤ extended_Gromov_product_at basepoint (to_Gromov_completion (v m)) (to_Gromov_completion (v n))"
if "n ≥ max N1 N2" "m ≥ max N1 N2" for m n
proof (rule D1(3))
have "dist (to_Gromov_completion (v m)) (to_Gromov_completion (v n))
≤ dist (to_Gromov_completion (v m)) (u m) + dist (u m) (u n) + dist (u n) (to_Gromov_completion (v n))"
by (intro mono_intros)
also have "... ≤ e + e + e"
apply (intro mono_intros)
using N1[of m n] N2[of n] N2[of m] that by (auto simp add: dist_commute)
also have "... ≤ e1" unfolding e_def by auto
finally show "dist (to_Gromov_completion (v m)) (to_Gromov_completion (v n)) ≤ e1" by simp
have "e ≤ e2" unfolding e_def using ‹e2 > 0› by auto
have "D1 ≤ extended_Gromov_product_at basepoint (u m) (to_Gromov_completion (v m))"
apply (rule D2(3)) using N2[of m] that ‹e ≤ e2› u[of m] by (auto simp add: dist_commute)
also have "... ≤ extended_Gromov_distance (to_Gromov_completion basepoint) (to_Gromov_completion (v m))"
using extended_Gromov_product_le_dist[of basepoint "to_Gromov_completion (v m)" "u m"]
by (simp add: extended_Gromov_product_at_commute)
finally show "D1 ≤ extended_Gromov_distance (to_Gromov_completion (v m)) (to_Gromov_completion basepoint)"
by (simp add: extended_Gromov_distance_commute)
qed
then have "M ≤ Gromov_product_at basepoint (v m) (v n)" if "n ≥ max N1 N2" "m ≥ max N1 N2" for m n
using that by auto
then show "∃N. ∀n ≥ N. ∀m ≥ N. M ≤ Gromov_product_at basepoint (v m) (v n)"
by blast
qed
then obtain l where l: "l ∈ Gromov_boundary" "(λn. to_Gromov_completion (v n)) ⇢ l"
using Gromov_converging_at_boundary_converges by blast
have "(λn. dist (u n) l) ⇢ 0+0"
proof (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. dist (u n) (to_Gromov_completion (v n)) + dist (to_Gromov_completion (v n)) l"])
show "(λn. dist (u n) (to_Gromov_completion (v n)) + dist (to_Gromov_completion (v n)) l) ⇢ 0 + 0"
apply (intro tendsto_intros)
using iffD1[OF tendsto_dist_iff l(2)] ‹(λn. dist (to_Gromov_completion (v n)) (u n)) ⇢ 0›
by (auto simp add: dist_commute)
qed (auto simp add: dist_triangle)
then have "u ⇢ l"
using iffD2[OF tendsto_dist_iff] by auto
then show "∃l∈Gromov_boundary. u ⇢ l"
using l(1) by auto
qed
text ‹When the initial space is complete, then the whole Gromov completion is also complete:
for Cauchy sequences tending to the Gromov boundary, then the convergence is proved as in the
completeness of the boundary above. For Cauchy sequences that remain bounded, the convergence
is reduced to the convergence inside the original space, which holds by assumption.›
proposition Gromov_completion_complete:
assumes "complete (UNIV::'a::Gromov_hyperbolic_space set)"
shows "complete (UNIV::'a Gromov_completion set)"
proof (rule completeI, auto)
fix u0::"nat ⇒ 'a Gromov_completion" assume "Cauchy u0"
show "∃l. u0 ⇢ l"
proof (cases "limsup (λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n)) = ∞")
case True
then obtain r where r: "strict_mono r" "(λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 (r n))) ⇢ ∞"
using limsup_subseq_lim[of "(λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n))"] unfolding comp_def
by auto
define u where "u = u0 o r"
then have "(λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u n)) ⇢ ∞"
unfolding comp_def using r(2) by simp
have "Cauchy u"
using ‹Cauchy u0› r(1) u_def by (simp add: Cauchy_subseq_Cauchy)
have *: "∃x ∈ range to_Gromov_completion. dist (u n) x < 1/real(n+1)" for n
by (rule closure_approachableD, auto)
have "∃v. ∀n. dist (to_Gromov_completion (v n)) (u n) < 1/real(n+1)"
using of_nat_less_top apply (intro choice) using * by (auto simp add: dist_commute)
then obtain v where v: "⋀n. dist (to_Gromov_completion (v n)) (u n) < 1/real(n+1)"
by blast
have "(λn. dist (to_Gromov_completion (v n)) (u n)) ⇢ 0"
apply (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. 1/real(n+1)"])
using v LIMSEQ_ignore_initial_segment[OF lim_1_over_n, of 1] unfolding eventually_sequentially
by (auto simp add: less_imp_le)
have "Gromov_converging_at_boundary v"
proof (rule Gromov_converging_at_boundaryI[of basepoint])
fix M::real
obtain D1 e1 where D1: "e1 > 0" "D1 < ∞" "⋀x y::'a Gromov_completion. dist x y ≤ e1 ⟹ extended_Gromov_distance x (to_Gromov_completion basepoint) ≥ D1 ⟹ extended_Gromov_product_at basepoint x y ≥ ereal M"
using large_Gromov_product_approx[of "ereal M"] by auto
obtain D2 e2 where D2: "e2 > 0" "D2 < ∞" "⋀x y::'a Gromov_completion. dist x y ≤ e2 ⟹ extended_Gromov_distance x (to_Gromov_completion basepoint) ≥ D2 ⟹ extended_Gromov_product_at basepoint x y ≥ D1"
using large_Gromov_product_approx[OF ‹D1 < ∞›] by auto
define e where "e = (min e1 e2)/3"
have "e > 0" unfolding e_def using ‹e1 > 0› ‹e2 > 0› by auto
then obtain N1 where N1: "⋀n m. n ≥ N1 ⟹ m ≥ N1 ⟹ dist (u n) (u m) < e"
using ‹Cauchy u› unfolding Cauchy_def by blast
have "eventually (λn. dist (to_Gromov_completion (v n)) (u n) < e) sequentially"
by (rule order_tendstoD[OF ‹(λn. dist (to_Gromov_completion (v n)) (u n)) ⇢ 0›], fact)
then obtain N2 where N2: "⋀n. n ≥ N2 ⟹ dist (to_Gromov_completion (v n)) (u n) < e"
unfolding eventually_sequentially by auto
have "eventually (λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u n) > D2) sequentially"
by (rule order_tendstoD[OF ‹(λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u n)) ⇢ ∞›], fact)
then obtain N3 where N3: "⋀n. n ≥ N3 ⟹ extended_Gromov_distance (to_Gromov_completion basepoint) (u n) > D2"
unfolding eventually_sequentially by auto
define N where "N = N1+N2+N3"
have N: "N ≥ N1" "N ≥ N2" "N ≥ N3" unfolding N_def by auto
have "ereal M ≤ extended_Gromov_product_at basepoint (to_Gromov_completion (v m)) (to_Gromov_completion (v n))"
if "n ≥ N" "m ≥ N" for m n
proof (rule D1(3))
have "dist (to_Gromov_completion (v m)) (to_Gromov_completion (v n))
≤ dist (to_Gromov_completion (v m)) (u m) + dist (u m) (u n) + dist (u n) (to_Gromov_completion (v n))"
by (intro mono_intros)
also have "... ≤ e + e + e"
apply (intro mono_intros)
using N1[of m n] N2[of n] N2[of m] that N by (auto simp add: dist_commute)
also have "... ≤ e1" unfolding e_def by auto
finally show "dist (to_Gromov_completion (v m)) (to_Gromov_completion (v n)) ≤ e1" by simp
have "e ≤ e2" unfolding e_def using ‹e2 > 0› by auto
have "D1 ≤ extended_Gromov_product_at basepoint (u m) (to_Gromov_completion (v m))"
apply (rule D2(3)) using N2[of m] N3[of m] that N ‹e ≤ e2›
by (auto simp add: dist_commute extended_Gromov_distance_commute)
also have "... ≤ extended_Gromov_distance (to_Gromov_completion basepoint) (to_Gromov_completion (v m))"
using extended_Gromov_product_le_dist[of basepoint "to_Gromov_completion (v m)" "u m"]
by (simp add: extended_Gromov_product_at_commute)
finally show "D1 ≤ extended_Gromov_distance (to_Gromov_completion (v m)) (to_Gromov_completion basepoint)"
by (simp add: extended_Gromov_distance_commute)
qed
then have "M ≤ Gromov_product_at basepoint (v m) (v n)" if "n ≥ N" "m ≥ N" for m n
using that by auto
then show "∃N. ∀n ≥ N. ∀m ≥ N. M ≤ Gromov_product_at basepoint (v m) (v n)"
by blast
qed
then obtain l where l: "l ∈ Gromov_boundary" "(λn. to_Gromov_completion (v n)) ⇢ l"
using Gromov_converging_at_boundary_converges by blast
have "(λn. dist (u n) l) ⇢ 0+0"
proof (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. dist (u n) (to_Gromov_completion (v n)) + dist (to_Gromov_completion (v n)) l"])
show "(λn. dist (u n) (to_Gromov_completion (v n)) + dist (to_Gromov_completion (v n)) l) ⇢ 0 + 0"
apply (intro tendsto_intros)
using iffD1[OF tendsto_dist_iff l(2)] ‹(λn. dist (to_Gromov_completion (v n)) (u n)) ⇢ 0›
by (auto simp add: dist_commute)
qed (auto simp add: dist_triangle)
then have "u ⇢ l"
using iffD2[OF tendsto_dist_iff] by auto
then have "u0 ⇢ l"
unfolding u_def using r(1) ‹Cauchy u0› Cauchy_converges_subseq by auto
then show "∃l. u0 ⇢ l"
by auto
next
case False
define C where "C = limsup (λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n)) + 1"
have "C < ∞" unfolding C_def using False less_top by fastforce
have *: "limsup (λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n)) ≥ 0"
by (intro le_Limsup always_eventually, auto)
have "limsup (λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n)) < C"
unfolding C_def using False * ereal_add_left_cancel_less by force
then have "eventually (λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n) < C) sequentially"
using Limsup_lessD by blast
then obtain N where N: "⋀n. n ≥ N ⟹ extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n) < C"
unfolding eventually_sequentially by auto
define r where "r = (λn. n + N)"
have r: "strict_mono r" unfolding r_def strict_mono_def by auto
define u where "u = (u0 o r)"
have "Cauchy u"
using ‹Cauchy u0› r(1) u_def by (simp add: Cauchy_subseq_Cauchy)
have u: "extended_Gromov_distance (to_Gromov_completion basepoint) (u n) ≤ C" for n
unfolding u_def comp_def r_def using N by (auto simp add: less_imp_le)
define v where "v = (λn. from_Gromov_completion (u n))"
have uv: "u n = to_Gromov_completion (v n)" for n
unfolding v_def apply (rule to_from_Gromov_completion[symmetric]) using u[of n] ‹C < ∞› by auto
have "Cauchy v"
proof (rule metric_CauchyI)
obtain a::real where a: "a > 0" "⋀x y::'a Gromov_completion. extended_Gromov_distance (to_Gromov_completion basepoint) x ≤ C ⟹ dist x y ≤ a
⟹ esqrt(extended_Gromov_distance x y) ≤ 2 * ereal(dist x y)"
using inside_Gromov_distance_approx[OF ‹C < ∞›] by auto
fix e::real assume "e > 0"
define e2 where "e2 = min (sqrt (e/2) /2) a"
have "e2 > 0" unfolding e2_def using ‹e > 0› ‹a > 0› by auto
then obtain N where N: "⋀m n. m ≥ N ⟹ n ≥ N ⟹ dist (u m) (u n) < e2"
using ‹Cauchy u› unfolding Cauchy_def by blast
have "dist (v m) (v n) < e" if "n ≥ N" "m ≥ N" for m n
proof -
have "ereal(sqrt(dist (v m) (v n))) = esqrt(extended_Gromov_distance (u m) (u n))"
unfolding uv by (auto simp add: esqrt_ereal_ereal_sqrt)
also have "... ≤ 2 * ereal(dist (u m) (u n))"
apply (rule a(2)) using u[of m] N[OF ‹m ≥ N› ‹n ≥ N›] unfolding e2_def by auto
also have "... = ereal(2 * dist (u m) (u n))"
by simp
also have "... ≤ ereal(2 * e2)"
apply (intro mono_intros) using N[OF ‹m ≥ N› ‹n ≥ N›] less_imp_le by auto
finally have "sqrt(dist (v m) (v n)) ≤ 2 * e2"
using ‹e2 > 0› by auto
also have "... ≤ sqrt (e/2)"
unfolding e2_def by auto
finally have "dist (v m) (v n) ≤ e/2"
by auto
then show ?thesis
using ‹e > 0› by auto
qed
then show "∃M. ∀m ≥ M. ∀n ≥ M. dist (v m) (v n) < e" by auto
qed
then obtain l where "v ⇢ l"
using ‹complete (UNIV::'a set)› complete_def by blast
then have "u ⇢ (to_Gromov_completion l)"
unfolding uv by auto
then have "u0 ⇢ (to_Gromov_completion l)"
unfolding u_def using r(1) ‹Cauchy u0› Cauchy_converges_subseq by auto
then show "∃l. u0 ⇢ l"
by auto
qed
qed
instance Gromov_completion::("{Gromov_hyperbolic_space, complete_space}") complete_space
apply standard
using Gromov_completion_complete complete_def convergent_def complete_UNIV by auto
text ‹When the original space is proper, i.e., closed balls are compact, and geodesic, then the
Gromov completion (and therefore the Gromov boundary) are compact. The idea to extract a convergent
subsequence of a sequence $u_n$ in the boundary is to take the point $v_n$ at distance $T$ along
a geodesic tending to the point $u_n$ on the boundary, where $T$ is fixed and large. The points
$v_n$ live in a bounded subset of the space, hence they have a convergent subsequence $v_{j(n)}$.
It follows that $u_{j(n)}$ is almost converging, up to an error that tends to $0$ when $T$ tends
to infinity. By a diagonal argument, we obtain a convergent subsequence of $u_n$.
As we have already proved that the space is complete, there is a shortcut to the above argument,
avoiding subsequences and diagonal argument altogether. Indeed, in a complete space it suffices
to show that for any $\epsilon > 0$ it is covered by finitely many balls of radius $\epsilon$ to get
the compactness. This is what we do in the following proof, although the argument is precisely
modelled on the first proof we have explained.›
theorem Gromov_completion_compact:
assumes "proper (UNIV::'a::Gromov_hyperbolic_space_geodesic set)"
shows "compact (UNIV::'a Gromov_completion set)"
proof -
have "∃k. finite k ∧ (UNIV::'a Gromov_completion set) ⊆ (⋃x∈k. ball x e)" if "e > 0" for e
proof -
define D::real where "D = max 0 (-ln(e/4)/epsilonG(TYPE('a)))"
have "D ≥ 0" unfolding D_def by auto
have "exp(-epsilonG(TYPE('a)) * D) ≤ exp(ln (e / 4))"
unfolding D_def apply (intro mono_intros) unfolding max_def
apply auto
using constant_in_extended_predist_pos(1)[where ?'a = 'a] by (auto simp add: divide_simps)
then have "exp(-epsilonG(TYPE('a)) * D) ≤ e/4" using ‹e > 0› by auto
define e0::real where "e0 = e * e / 16"
have "e0 > 0" using ‹e > 0› unfolding e0_def by auto
obtain k::"'a set" where k: "finite k" "cball basepoint D ⊆ (⋃x∈k. ball x e0)"
using compact_eq_totally_bounded[of "cball (basepoint::'a) D"] assms ‹e0 > 0›
unfolding proper_def by auto
have A: "∃y ∈ k. dist (to_Gromov_completion y) (to_Gromov_completion x) ≤ e/4" if "dist basepoint x ≤ D" for x::'a
proof -
obtain z where z: "z ∈ k" "dist z x < e0" using ‹dist basepoint x ≤ D› k(2) by auto
have "ereal(dist (to_Gromov_completion z) (to_Gromov_completion x)) ≤ esqrt(extended_Gromov_distance (to_Gromov_completion z) (to_Gromov_completion x))"
by (intro mono_intros)
also have "... = ereal(sqrt (dist z x))"
by auto
finally have "dist (to_Gromov_completion z) (to_Gromov_completion x) ≤ sqrt (dist z x)"
by auto
also have "... ≤ sqrt e0"
using z(2) by auto
also have "... ≤ e/4"
unfolding e0_def using ‹e > 0› by (auto simp add: less_imp_le real_sqrt_divide)
finally have "dist (to_Gromov_completion z) (to_Gromov_completion x) ≤ e/4"
by auto
then show ?thesis
using ‹z ∈ k› by auto
qed
have B: "∃y ∈ k. dist (to_Gromov_completion y) (to_Gromov_completion x) ≤ e/2" for x
proof (cases "dist basepoint x ≤ D")
case True
have "e/4 ≤ e/2" using ‹e > 0› by auto
then show ?thesis using A[OF True] by force
next
case False
define x2 where "x2 = geodesic_segment_param {basepoint--x} basepoint D"
have *: "Gromov_product_at basepoint x x2 = D"
unfolding x2_def apply (rule Gromov_product_geodesic_segment) using False ‹D ≥ 0› by auto
have "ereal(dist (to_Gromov_completion x) (to_Gromov_completion x2))
≤ eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (to_Gromov_completion x) (to_Gromov_completion x2))"
by (intro mono_intros)
also have "... = eexp (- epsilonG(TYPE('a)) * ereal D)"
using * by auto
also have "... = ereal(exp(-epsilonG(TYPE('a)) * D))"
by auto
also have "... ≤ ereal(e/4)"
by (intro mono_intros, fact)
finally have "dist (to_Gromov_completion x) (to_Gromov_completion x2) ≤ e/4"
using ‹e > 0› by auto
have "dist basepoint x2 ≤ D"
unfolding x2_def using False ‹0 ≤ D› by auto
then obtain y where "y ∈ k" "dist (to_Gromov_completion y) (to_Gromov_completion x2) ≤ e/4"
using A by auto
have "dist (to_Gromov_completion y) (to_Gromov_completion x)
≤ dist (to_Gromov_completion y) (to_Gromov_completion x2) + dist (to_Gromov_completion x) (to_Gromov_completion x2)"
by (intro mono_intros)
also have "... ≤ e/4 + e/4"
by (intro mono_intros, fact, fact)
also have "... = e/2" by simp
finally show ?thesis using ‹y ∈ k› by auto
qed
have C: "∃y ∈ k. dist (to_Gromov_completion y) x < e" for x
proof -
obtain x1 where x1: "dist x x1 < e/2" "x1 ∈ range to_Gromov_completion"
using to_Gromov_completion_range_dense ‹e > 0›
by (metis (no_types, hide_lams) UNIV_I closure_approachableD divide_pos_pos zero_less_numeral)
then obtain z where z: "x1 = to_Gromov_completion z" by auto
then obtain y where y: "y ∈ k" "dist (to_Gromov_completion y) (to_Gromov_completion z) ≤ e/2"
using B by auto
have "dist (to_Gromov_completion y) x ≤
dist (to_Gromov_completion y) (to_Gromov_completion z) + dist x x1"
unfolding z by (intro mono_intros)
also have "... < e/2 + e/2"
using x1(1) y(2) by auto
also have "... = e"
by auto
finally show ?thesis using ‹y ∈ k› by auto
qed
show ?thesis
apply (rule exI[of _ "to_Gromov_completion`k"])
using C ‹finite k› by auto
qed
then show ?thesis
unfolding compact_eq_totally_bounded
using Gromov_completion_complete[OF complete_of_proper[OF assms]] by auto
qed
text ‹If the inner space is second countable, so is its completion, as the former is dense in the
latter.›
instance Gromov_completion::("{Gromov_hyperbolic_space, second_countable_topology}") second_countable_topology
proof
obtain A::"'a set" where "countable A" "closure A = UNIV"
using second_countable_metric_dense_subset by auto
define Ab where "Ab = to_Gromov_completion`A"
have "range to_Gromov_completion ⊆ closure Ab"
unfolding Ab_def
by (metis ‹closure A = UNIV› closed_closure closure_subset image_closure_subset to_Gromov_completion_continuous)
then have "closure Ab = UNIV"
by (metis closed_closure closure_minimal dual_order.antisym to_Gromov_completion_range_dense top_greatest)
moreover have "countable Ab" unfolding Ab_def using ‹countable A› by auto
ultimately have "∃Ab::'a Gromov_completion set. countable Ab ∧ closure Ab = UNIV"
by auto
then show "∃B::'a Gromov_completion set set. countable B ∧ open = generate_topology B"
using second_countable_iff_dense_countable_subset topological_basis_imp_subbasis by auto
qed
text ‹The same follows readily for the Polish space property.›
instance metric_completion::("{Gromov_hyperbolic_space, polish_space}") polish_space
by standard
subsection ‹The Gromov completion of the real line.›
text ‹We show in the paragraph that the Gromov completion of the real line is obtained by adding
one point at $+\infty$ and one point at $-\infty$. In other words, it coincides with ereal.
To show this, we have to understand which sequences of reals are Gromov-converging to the
boundary. We show in the next lemma that they are exactly the sequences that converge to $-\infty$
or to $+\infty$.›
lemma real_Gromov_converging_to_boundary:
fixes u::"nat ⇒ real"
shows "Gromov_converging_at_boundary u ⟷ ((u ⇢ ∞) ∨ (u ⇢ - ∞))"
proof -
have *: "Gromov_product_at 0 m n ≥ min m n" for m n::real
unfolding Gromov_product_at_def dist_real_def by auto
have A: "Gromov_converging_at_boundary u" if "u ⇢ ∞" for u::"nat ⇒ real"
proof (rule Gromov_converging_at_boundaryI[of 0])
fix M::real
have "eventually (λn. ereal (u n) > M) sequentially"
by (rule order_tendstoD(1)[OF ‹u ⇢ ∞›, of "ereal M"], auto)
then obtain N where "⋀n. n ≥ N ⟹ ereal (u n) > M"
unfolding eventually_sequentially by auto
then have A: "u n ≥ M" if "n ≥ N" for n
by (simp add: less_imp_le that)
have "M ≤ Gromov_product_at 0 (u m) (u n)" if "n ≥ N" "m ≥ N" for m n
using A[OF ‹m ≥ N›] A[OF ‹n ≥ N›] *[of "u m" "u n"] by auto
then show "∃N. ∀n ≥ N. ∀m ≥ N. M ≤ Gromov_product_at 0 (u m) (u n)"
by auto
qed
have *: "Gromov_product_at 0 m n ≥ - max m n" for m n::real
unfolding Gromov_product_at_def dist_real_def by auto
have B: "Gromov_converging_at_boundary u" if "u ⇢ -∞" for u::"nat ⇒ real"
proof (rule Gromov_converging_at_boundaryI[of 0])
fix M::real
have "eventually (λn. ereal (u n) < - M) sequentially"
by (rule order_tendstoD(2)[OF ‹u ⇢ -∞›, of "ereal (-M)"], auto)
then obtain N where "⋀n. n ≥ N ⟹ ereal (u n) < - M"
unfolding eventually_sequentially by auto
then have A: "u n ≤ - M" if "n ≥ N" for n
by (simp add: less_imp_le that)
have "M ≤ Gromov_product_at 0 (u m) (u n)" if "n ≥ N" "m ≥ N" for m n
using A[OF ‹m ≥ N›] A[OF ‹n ≥ N›] *[of "u m" "u n"] by auto
then show "∃N. ∀n ≥ N. ∀m ≥ N. M ≤ Gromov_product_at 0 (u m) (u n)"
by auto
qed
have L: "(u ⇢ ∞) ∨ (u ⇢ - ∞)" if "Gromov_converging_at_boundary u" for u::"nat ⇒ real"
proof -
have "(λn. abs(u n)) ⇢ ∞"
using Gromov_converging_at_boundary_imp_unbounded[OF that, of 0] unfolding dist_real_def by auto
obtain r where r: "strict_mono r" "(λn. ereal (u (r n))) ⇢ liminf (λn. ereal(u n))"
using liminf_subseq_lim[of "λn. ereal(u n)"] unfolding comp_def by auto
have "(λn. abs(ereal (u (r n)))) ⇢ abs(liminf (λn. ereal(u n)))"
apply (intro tendsto_intros) using r(2) by auto
moreover have "(λn. abs(ereal (u (r n)))) ⇢ ∞"
using ‹(λn. abs(u n)) ⇢ ∞› apply auto
using filterlim_compose filterlim_subseq[OF r(1)] by blast
ultimately have A: "abs(liminf (λn. ereal(u n))) = ∞"
using LIMSEQ_unique by auto
obtain r where r: "strict_mono r" "(λn. ereal (u (r n))) ⇢ limsup (λn. ereal(u n))"
using limsup_subseq_lim[of "λn. ereal(u n)"] unfolding comp_def by auto
have "(λn. abs(ereal (u (r n)))) ⇢ abs(limsup (λn. ereal(u n)))"
apply (intro tendsto_intros) using r(2) by auto
moreover have "(λn. abs(ereal (u (r n)))) ⇢ ∞"
using ‹(λn. abs(u n)) ⇢ ∞› apply auto
using filterlim_compose filterlim_subseq[OF r(1)] by blast
ultimately have B: "abs(limsup (λn. ereal(u n))) = ∞"
using LIMSEQ_unique by auto
have "¬(liminf u = - ∞ ∧ limsup u = ∞)"
proof (rule ccontr, auto)
assume "liminf u = -∞" "limsup u = ∞"
have "∃N. ∀n ≥ N. ∀m ≥ N. Gromov_product_at 0 (u m) (u n) ≥ 1"
using that unfolding Gromov_converging_at_boundary_def by blast
then obtain N where N: "⋀m n. m ≥ N ⟹ n ≥ N ⟹ Gromov_product_at 0 (u m) (u n) ≥ 1"
by auto
have "∃n ≥ N. ereal(u n) > ereal 0"
apply (rule limsup_obtain) unfolding ‹limsup u = ∞› by auto
then obtain n where n: "n ≥ N" "u n > 0" by auto
have "∃n ≥ N. ereal(u n) < ereal 0"
apply (rule liminf_obtain) unfolding ‹liminf u = -∞› by auto
then obtain m where m: "m ≥ N" "u m < 0" by auto
have "Gromov_product_at 0 (u m) (u n) = 0"
unfolding Gromov_product_at_def dist_real_def using m n by auto
then show False using N[OF m(1) n(1)] by auto
qed
then have "liminf u = ∞ ∨ limsup u = - ∞"
using A B by auto
then show ?thesis
by (simp add: Liminf_PInfty Limsup_MInfty)
qed
show ?thesis using L A B by auto
qed
text ‹There is one single point at infinity in the Gromov completion of reals, i.e., two
sequences tending to infinity are equivalent.›
lemma real_Gromov_completion_rel_PInf:
fixes u v::"nat ⇒ real"
assumes "u ⇢ ∞" "v ⇢ ∞"
shows "Gromov_completion_rel u v"
proof -
have *: "Gromov_product_at 0 m n ≥ min m n" for m n::real
unfolding Gromov_product_at_def dist_real_def by auto
have **: "Gromov_product_at a m n ≥ min m n - abs a" for m n a::real
using Gromov_product_at_diff1[of 0 m n a] *[of m n] by auto
have "(λn. Gromov_product_at a (u n) (v n)) ⇢ ∞" for a
proof (rule tendsto_sandwich[of "λn. min (u n) (v n) - abs a" _ _ "λn. ∞"])
have "ereal (min (u n) (v n) - ¦a¦) ≤ ereal (Gromov_product_at a (u n) (v n))" for n
using **[of "u n" "v n" a] by auto
then show "∀⇩F n in sequentially. ereal (min (u n) (v n) - ¦a¦) ≤ ereal (Gromov_product_at a (u n) (v n))"
by auto
have "(λx. min (ereal(u x)) (ereal (v x)) - ereal ¦a¦) ⇢ min ∞ ∞ - ereal ¦a¦"
apply (intro tendsto_intros) using assms by auto
then show "(λx. ereal (min (u x) (v x) - ¦a¦)) ⇢ ∞"
apply auto unfolding ereal_minus(1)[symmetric] by auto
qed (auto)
moreover have "Gromov_converging_at_boundary u" "Gromov_converging_at_boundary v"
using real_Gromov_converging_to_boundary assms by auto
ultimately show ?thesis unfolding Gromov_completion_rel_def by auto
qed
text ‹There is one single point at minus infinity in the Gromov completion of reals, i.e., two
sequences tending to minus infinity are equivalent.›
lemma real_Gromov_completion_rel_MInf:
fixes u v::"nat ⇒ real"
assumes "u ⇢ -∞" "v ⇢ -∞"
shows "Gromov_completion_rel u v"
proof -
have *: "Gromov_product_at 0 m n ≥ - max m n" for m n::real
unfolding Gromov_product_at_def dist_real_def by auto
have **: "Gromov_product_at a m n ≥ - max m n - abs a" for m n a::real
using Gromov_product_at_diff1[of 0 m n a] *[of m n] by auto
have "(λn. Gromov_product_at a (u n) (v n)) ⇢ ∞" for a
proof (rule tendsto_sandwich[of "λn. min (-u n) (-v n) - abs a" _ _ "λn. ∞"])
have "ereal (min (-u n) (-v n) - ¦a¦) ≤ ereal (Gromov_product_at a (u n) (v n))" for n
using **[of "u n" "v n" a] by auto
then show "∀⇩F n in sequentially. ereal (min (-u n) (-v n) - ¦a¦) ≤ ereal (Gromov_product_at a (u n) (v n))"
by auto
have "(λx. min (-ereal(u x)) (-ereal (v x)) - ereal ¦a¦) ⇢ min (-(-∞)) (-(-∞)) - ereal ¦a¦"
apply (intro tendsto_intros) using assms by auto
then show "(λx. ereal (min (-u x) (-v x) - ¦a¦)) ⇢ ∞"
apply auto unfolding ereal_minus(1)[symmetric] by auto
qed (auto)
moreover have "Gromov_converging_at_boundary u" "Gromov_converging_at_boundary v"
using real_Gromov_converging_to_boundary assms by auto
ultimately show ?thesis unfolding Gromov_completion_rel_def by auto
qed
text ‹It follows from the two lemmas above that the Gromov completion of reals is obtained by
adding one single point at infinity and one single point at minus infinity. Hence, it is in
bijection with the extended reals.›
function to_real_Gromov_completion::"ereal ⇒ real Gromov_completion"
where "to_real_Gromov_completion (ereal r) = to_Gromov_completion r"
| "to_real_Gromov_completion (∞) = abs_Gromov_completion (λn. n)"
| "to_real_Gromov_completion (-∞) = abs_Gromov_completion (λn. -n)"
by (auto intro: ereal_cases)
termination by standard (rule wf_empty)
text ‹To prove the bijectivity, we prove by hand injectivity and surjectivity using the above
lemmas.›
lemma bij_to_real_Gromov_completion:
"bij to_real_Gromov_completion"
proof -
have [simp]: "Gromov_completion_rel (λn. n) (λn. n)"
by (intro real_Gromov_completion_rel_PInf tendsto_intros)
have [simp]: "Gromov_completion_rel (λn. -real n) (λn. -real n)"
by (intro real_Gromov_completion_rel_MInf tendsto_intros)
have "∃x. to_real_Gromov_completion x = y" for y
proof (cases y)
case (to_Gromov_completion x)
then have "y = to_real_Gromov_completion x" by auto
then show ?thesis by blast
next
case boundary
define u where u: "u = rep_Gromov_completion y"
have y: "abs_Gromov_completion u = y" "Gromov_completion_rel u u"
unfolding u using Quotient3_abs_rep[OF Quotient3_Gromov_completion]
Quotient3_rep_reflp[OF Quotient3_Gromov_completion] by auto
have "Gromov_converging_at_boundary u"
using u boundary by (simp add: Gromov_boundary_rep_converging)
then have "(u ⇢ ∞) ∨ (u ⇢ - ∞)" using real_Gromov_converging_to_boundary by auto
then show ?thesis
proof
assume "u ⇢ ∞"
have "abs_Gromov_completion (λn. n) = abs_Gromov_completion u "
apply (rule Quotient3_rel_abs[OF Quotient3_Gromov_completion])
by (intro real_Gromov_completion_rel_PInf[OF _ ‹u ⇢ ∞›] tendsto_intros)
then have "to_real_Gromov_completion ∞ = y"
unfolding y by auto
then show ?thesis by blast
next
assume "u ⇢ -∞"
have "abs_Gromov_completion (λn. -real n) = abs_Gromov_completion u "
apply (rule Quotient3_rel_abs[OF Quotient3_Gromov_completion])
by (intro real_Gromov_completion_rel_MInf[OF _ ‹u ⇢ -∞›] tendsto_intros)
then have "to_real_Gromov_completion (-∞) = y"
unfolding y by auto
then show ?thesis by blast
qed
qed
then have "surj to_real_Gromov_completion"
unfolding surj_def by metis
have "to_real_Gromov_completion ∞ ∈ Gromov_boundary"
"to_real_Gromov_completion (-∞) ∈ Gromov_boundary"
by (auto intro!: abs_Gromov_completion_in_Gromov_boundary tendsto_intros simp add: real_Gromov_converging_to_boundary)
moreover have "to_real_Gromov_completion ∞ ≠ to_real_Gromov_completion (-∞)"
proof -
have "Gromov_product_at 0 (real n) (-real n) = 0" for n::nat
unfolding Gromov_product_at_def dist_real_def by auto
then have *: "(λn. ereal(Gromov_product_at 0 (real n) (-real n))) ⇢ ereal 0" by auto
have "¬((λn. Gromov_product_at 0 (real n) (-real n)) ⇢ ∞)"
using LIMSEQ_unique[OF *] by fastforce
then have "¬(Gromov_completion_rel (λn. n) (λn. -n))"
unfolding Gromov_completion_rel_def by auto (metis nat.simps(3) of_nat_0 of_nat_eq_0_iff)
then show ?thesis
using Quotient3_rel[OF Quotient3_Gromov_completion, of "λn. n" "λn. -real n"] by auto
qed
ultimately have "x = y" if "to_real_Gromov_completion x = to_real_Gromov_completion y" for x y
using that injD[OF to_Gromov_completion_inj] apply (cases x y rule: ereal2_cases)
by (auto) (metis not_in_Gromov_boundary')+
then have "inj to_real_Gromov_completion"
unfolding inj_def by auto
then show "bij to_real_Gromov_completion"
using ‹surj to_real_Gromov_completion› by (simp add: bijI)
qed
text ‹Next, we prove that we have a homeomorphism. By compactness of ereals, it suffices to show
that the inclusion map is continuous everywhere. It would be a pain to distinguish all the time if points are
at infinity or not, we rather use a criterion saying that it suffices to prove sequential
continuity for sequences taking values in a dense subset of the space, here we take the reals.
Hence, it suffices to show that if a sequence of reals $v_n$ converges to a limit $a$ in the
extended reals, then the image of $v_n$ in the Gromov completion (which is an inner point) converges
to the point corresponding to $a$. We treat separately the cases $a\in \mathbb{R}$, $a = \infty$ and
$a = -\infty$. In the first case, everything is trivial. In the other cases, we have characterized
in general sequences inside the space that converge to a boundary point, as sequences in the equivalence
class defining this boundary point. Since we have described explicitly these equivalence classes in
the case of the Gromov completion of the reals (they are respectively the sequences tending to
$\infty$ and to $-\infty$), the result follows readily without any additional computation.›
proposition homeo_to_real_Gromov_completion:
"homeomorphism_on UNIV to_real_Gromov_completion"
proof (rule homeomorphism_on_compact)
show "inj to_real_Gromov_completion"
using bij_to_real_Gromov_completion by (simp add: bij_betw_def)
show "compact (UNIV::ereal set)"
by (simp add: compact_UNIV)
show "continuous_on UNIV to_real_Gromov_completion"
proof (rule continuous_on_extension_sequentially[of _ "{-∞<..<∞}"], auto)
fix u::"nat ⇒ ereal" and b::ereal assume u: "∀n. u n ≠ - ∞ ∧ u n ≠ ∞" "u ⇢ b"
define v where "v = (λn. real_of_ereal (u n))"
have uv: "u n = ereal (v n)" for n
using u unfolding v_def by (simp add: ereal_infinity_cases ereal_real)
show "(λn. to_real_Gromov_completion (u n)) ⇢ to_real_Gromov_completion b"
proof (cases b)
case (real r)
then show ?thesis using ‹u ⇢ b› unfolding uv by auto
next
case PInf
then have *: "(λn. ereal (v n)) ⇢ ∞" using ‹u ⇢ b› unfolding uv by auto
have A: "Gromov_completion_rel real v" "Gromov_completion_rel real real" "Gromov_completion_rel v v"
by (auto intro!: real_Gromov_completion_rel_PInf * tendsto_intros)
then have B: "abs_Gromov_completion v = abs_Gromov_completion real"
using Quotient3_rel_abs[OF Quotient3_Gromov_completion] by force
then show ?thesis using ‹u ⇢ b› PInf
unfolding uv apply auto
apply (subst Gromov_completion_converge_to_boundary)
using id_nat_ereal_tendsto_PInf real_Gromov_converging_to_boundary A B by auto
next
case MInf
then have *: "(λn. ereal (v n)) ⇢ -∞" using ‹u ⇢ b› unfolding uv by auto
have A: "Gromov_completion_rel (λn. -real n) v" "Gromov_completion_rel (λn. -real n) (λn. -real n)" "Gromov_completion_rel v v"
by (auto intro!: real_Gromov_completion_rel_MInf * tendsto_intros)
then have B: "abs_Gromov_completion v = abs_Gromov_completion (λn. -real n)"
using Quotient3_rel_abs[OF Quotient3_Gromov_completion] by force
then show ?thesis using ‹u ⇢ b› MInf
unfolding uv apply auto
apply (subst Gromov_completion_converge_to_boundary)
using id_nat_ereal_tendsto_PInf real_Gromov_converging_to_boundary A B
by (auto simp add: ereal_minus_real_tendsto_MInf)
qed
qed
qed
end
Theory Boundary_Extension
theory Boundary_Extension
imports Morse_Gromov_Theorem Gromov_Boundary
begin
section ‹Extension of quasi-isometries to the boundary›
text ‹In this section, we show that a quasi-isometry between geodesic Gromov hyperbolic spaces
extends to a homeomorphism between their boundaries.›
text ‹Applying a quasi-isometry on a geodesic triangle essentially sends it to a geodesic triangle,
in hyperbolic spaces. It follows that, up to an additive constant, the Gromov product, which is the
distance to the center of the triangle, is multiplied by a constant between $\lambda^{-1}$ and
$\lambda$ when one applies a quasi-isometry. This argument is given in the next lemma. This implies
that two points are close in the Gromov completion if and only if their images are also close in the
Gromov completion of the image. Essentially, this lemma implies that a quasi-isometry has a
continuous extension to the Gromov boundary, which is a homeomorphism.›
lemma Gromov_product_at_quasi_isometry:
fixes f::"'a::Gromov_hyperbolic_space_geodesic ⇒ 'b::Gromov_hyperbolic_space_geodesic"
assumes "lambda C-quasi_isometry f"
shows "Gromov_product_at (f x) (f y) (f z) ≥ Gromov_product_at x y z / lambda - 187 * lambda^2 * (C + deltaG(TYPE('a)) + deltaG(TYPE('b)))"
"Gromov_product_at (f x) (f y) (f z) ≤ lambda * Gromov_product_at x y z + 187 * lambda^2 * (C + deltaG(TYPE('a)) + deltaG(TYPE('b)))"
proof -
have "lambda ≥ 1" "C ≥ 0" using quasi_isometry_onD[OF assms(1)] by auto
define D where "D = 92 * lambda^2 * (C + deltaG(TYPE('b)))"
have Dxy: "hausdorff_distance (f`{x--y}) {f x--f y} ≤ D"
unfolding D_def apply (rule geodesic_quasi_isometric_image[OF assms(1)]) by auto
have Dyz: "hausdorff_distance (f`{y--z}) {f y--f z} ≤ D"
unfolding D_def apply (rule geodesic_quasi_isometric_image[OF assms(1)]) by auto
have Dxz: "hausdorff_distance (f`{x--z}) {f x--f z} ≤ D"
unfolding D_def apply (rule geodesic_quasi_isometric_image[OF assms(1)]) by auto
define E where "E = (lambda * (4 * deltaG(TYPE('a))) + C) + D"
have "E ≥ 0" unfolding E_def D_def using ‹lambda ≥ 1› ‹C ≥ 0› by auto
obtain w where w: "infdist w {x--y} ≤ 4 * deltaG(TYPE('a))"
"infdist w {x--z} ≤ 4 * deltaG(TYPE('a))"
"infdist w {y--z} ≤ 4 * deltaG(TYPE('a))"
"dist w x = Gromov_product_at x y z"
using slim_triangle[of "{x--y}" x y "{x--z}" z "{y--z}"] by auto
have "infdist (f w) {f x--f y} ≤ infdist (f w) (f`{x--y}) + hausdorff_distance (f`{x--y}) {f x--f y}"
by (intro mono_intros quasi_isometry_on_bounded[OF quasi_isometry_on_subset[OF assms(1)], of "{x--y}"], auto)
also have "... ≤ (lambda * infdist w {x--y} + C) + D"
apply (intro mono_intros) using quasi_isometry_on_infdist[OF assms(1)] Dxy by auto
also have "... ≤ (lambda * (4 * deltaG(TYPE('a))) + C) + D"
apply (intro mono_intros) using w ‹lambda ≥ 1› by auto
finally have Exy: "infdist (f w) {f x--f y} ≤ E" unfolding E_def by auto
have "infdist (f w) {f y--f z} ≤ infdist (f w) (f`{y--z}) + hausdorff_distance (f`{y--z}) {f y--f z}"
by (intro mono_intros quasi_isometry_on_bounded[OF quasi_isometry_on_subset[OF assms(1)], of "{y--z}"], auto)
also have "... ≤ (lambda * infdist w {y--z} + C) + D"
apply (intro mono_intros) using quasi_isometry_on_infdist[OF assms(1)] Dyz by auto
also have "... ≤ (lambda * (4 * deltaG(TYPE('a))) + C) + D"
apply (intro mono_intros) using w ‹lambda ≥ 1› by auto
finally have Eyz: "infdist (f w) {f y--f z} ≤ E" unfolding E_def by auto
have "infdist (f w) {f x--f z} ≤ infdist (f w) (f`{x--z}) + hausdorff_distance (f`{x--z}) {f x--f z}"
by (intro mono_intros quasi_isometry_on_bounded[OF quasi_isometry_on_subset[OF assms(1)], of "{x--z}"], auto)
also have "... ≤ (lambda * infdist w {x--z} + C) + D"
apply (intro mono_intros) using quasi_isometry_on_infdist[OF assms(1)] Dxz by auto
also have "... ≤ (lambda * (4 * deltaG(TYPE('a))) + C) + D"
apply (intro mono_intros) using w ‹lambda ≥ 1› by auto
finally have Exz: "infdist (f w) {f x--f z} ≤ E" unfolding E_def by auto
have "2 * ((1/lambda * dist w x - C)) ≤ 2 * dist (f w) (f x)"
using quasi_isometry_onD(2)[OF assms(1), of w x] by auto
also have "... = (dist (f w) (f x) + dist (f w) (f y)) + (dist (f w) (f x) + dist (f w) (f z)) - (dist (f w) (f y) + dist (f w) (f z))"
by auto
also have "... ≤ (dist (f x) (f y) + 2 * infdist (f w) {f x--f y}) + (dist (f x) (f z) + 2 * infdist (f w) {f x--f z}) - dist (f y) (f z)"
by (intro geodesic_segment_distance mono_intros, auto)
also have "... ≤ 2 * Gromov_product_at (f x) (f y) (f z) + 4 * E"
unfolding Gromov_product_at_def using Exy Exz by (auto simp add: algebra_simps divide_simps)
finally have *: "Gromov_product_at x y z / lambda - C - 2 * E ≤ Gromov_product_at (f x) (f y) (f z)"
unfolding w(4) by simp
have "2 * Gromov_product_at (f x) (f y) (f z) - 2 * E ≤ 2 * Gromov_product_at (f x) (f y) (f z) - 2 * infdist (f w) {f y--f z}"
using Eyz by auto
also have "... = dist (f x) (f y) + dist (f x) (f z) - (dist (f y) (f z) + 2 * infdist (f w) {f y--f z})"
unfolding Gromov_product_at_def by (auto simp add: algebra_simps divide_simps)
also have "... ≤ (dist (f w) (f x) + dist (f w) (f y)) + (dist (f w) (f x) + dist (f w) (f z)) - (dist (f w) (f y) + dist (f w) (f z))"
by (intro geodesic_segment_distance mono_intros, auto)
also have "... = 2 * dist (f w) (f x)"
by auto
also have "... ≤ 2 * (lambda * dist w x + C)"
using quasi_isometry_onD(1)[OF assms(1), of w x] by auto
finally have "Gromov_product_at (f x) (f y) (f z) ≤ lambda * dist w x + C + E"
by auto
then have **: "Gromov_product_at (f x) (f y) (f z) ≤ lambda * Gromov_product_at x y z + C + 2 * E"
unfolding w(4) using ‹E ≥ 0› by auto
have "C + 2 * E = 3 * 1 * C + 8 * lambda * deltaG(TYPE('a)) + 184 * lambda^2 * C + 184 * lambda^2 * deltaG(TYPE('b))"
unfolding E_def D_def by (auto simp add: algebra_simps)
also have "... ≤ 3 * lambda^2 * C + 187 * lambda^2 * deltaG(TYPE('a)) + 184 * lambda^2 * C + 187 * lambda^2 * deltaG(TYPE('b))"
apply (intro mono_intros) using ‹lambda ≥ 1› ‹C ≥ 0› by auto
finally have I: "C + 2 * E ≤ 187 * lambda^2 * (C + deltaG(TYPE('a)) + deltaG(TYPE('b)))"
by (auto simp add: algebra_simps)
show "Gromov_product_at (f x) (f y) (f z) ≥ Gromov_product_at x y z / lambda - 187 * lambda^2 * (C + deltaG(TYPE('a)) + deltaG(TYPE('b)))"
using * I by auto
show "Gromov_product_at (f x) (f y) (f z) ≤ lambda * Gromov_product_at x y z + 187 * lambda^2 * (C + deltaG(TYPE('a)) + deltaG(TYPE('b)))"
using ** I by auto
qed
lemma Gromov_converging_at_infinity_quasi_isometry:
fixes f::"'a::Gromov_hyperbolic_space_geodesic ⇒ 'b::Gromov_hyperbolic_space_geodesic"
assumes "lambda C-quasi_isometry f"
shows "Gromov_converging_at_boundary (λn. f (u n)) ⟷ Gromov_converging_at_boundary u"
proof
assume "Gromov_converging_at_boundary u"
show "Gromov_converging_at_boundary (λn. f (u n))"
proof (rule Gromov_converging_at_boundaryI[of "f (basepoint)"])
have "lambda ≥ 1" "C ≥ 0" using quasi_isometry_onD[OF assms(1)] by auto
define D where "D = 187 * lambda^2 * (C + deltaG(TYPE('a)) + deltaG(TYPE('b)))"
fix M::real
obtain M2::real where M2: "M = M2/lambda - D"
using ‹lambda ≥ 1› by (auto simp add: algebra_simps divide_simps)
obtain N where N: "⋀m n. m ≥ N ⟹ n ≥ N ⟹ Gromov_product_at basepoint (u m) (u n) ≥ M2"
using ‹Gromov_converging_at_boundary u› unfolding Gromov_converging_at_boundary_def by blast
have "Gromov_product_at (f basepoint) (f (u m)) (f (u n)) ≥ M" if "m ≥ N" "n ≥ N" for m n
proof -
have "M ≤ Gromov_product_at basepoint (u m) (u n)/lambda - D"
unfolding M2 using N[OF that] ‹lambda ≥ 1› by (auto simp add: divide_simps)
also have "... ≤ Gromov_product_at (f basepoint) (f (u m)) (f (u n))"
unfolding D_def by (rule Gromov_product_at_quasi_isometry[OF assms(1)])
finally show ?thesis by simp
qed
then show "∃N. ∀n ≥ N. ∀m ≥ N. M ≤ Gromov_product_at (f basepoint) (f (u m)) (f (u n))"
unfolding comp_def by auto
qed
next
assume "Gromov_converging_at_boundary (λn. f (u n))"
show "Gromov_converging_at_boundary u"
proof (rule Gromov_converging_at_boundaryI[of "basepoint"])
have "lambda ≥ 1" "C ≥ 0" using quasi_isometry_onD[OF assms(1)] by auto
define D where "D = 187 * lambda^2 * (C + deltaG(TYPE('a)) + deltaG(TYPE('b)))"
fix M::real
define M2 where "M2 = lambda * M + D"
have M2: "M = (M2 - D)/lambda" unfolding M2_def using ‹lambda ≥ 1› by (auto simp add: algebra_simps divide_simps)
obtain N where N: "⋀m n. m ≥ N ⟹ n ≥ N ⟹ Gromov_product_at (f basepoint) (f (u m)) (f (u n)) ≥ M2"
using ‹Gromov_converging_at_boundary (λn. f (u n))› unfolding Gromov_converging_at_boundary_def by blast
have "Gromov_product_at basepoint (u m) (u n) ≥ M" if "m ≥ N" "n ≥ N" for m n
proof -
have "M2 ≤ Gromov_product_at (f basepoint) (f (u m)) (f (u n))"
using N[OF that] by auto
also have "... ≤ lambda * Gromov_product_at basepoint (u m) (u n) + D"
unfolding D_def by (rule Gromov_product_at_quasi_isometry[OF assms(1)])
finally show "M ≤ Gromov_product_at basepoint (u m) (u n)"
unfolding M2 using ‹lambda ≥ 1› by (auto simp add: algebra_simps divide_simps)
qed
then show "∃N. ∀n ≥ N. ∀m ≥ N. Gromov_product_at basepoint (u m) (u n) ≥ M"
by auto
qed
qed
text ‹We define the extension to the completion of a function $f: X \to Y$ where $X$ and $Y$
are geodesic Gromov-hyperbolic spaces, as a function from $X \cup \partial X$ to $Y\cup \partial Y$,
as follows. If $x$ is in the space, we just use $f(x)$ (with the suitable coercions for the
definition). Otherwise, we wish to define $f(x)$ as the limit of $f(u_n)$ for all sequences tending
to $x$. For the definition, we use one such sequence chosen arbitrarily (this is the role of
\verb+rep_Gromov_completion x+ below, it is indeed a sequence in the space tending to $x$), and
we use the limit of $f(u_n)$ (if it exists, otherwise the framework will choose some point for us
but it will make no sense whatsoever).
For quasi-isometries, we have indeed that $f(u_n)$ converges if $u_n$ converges to a boundary point,
by \verb+Gromov_converging_at_infinity_quasi_isometry+, so this definition is meaningful. Moreover,
continuity of the extension follows readily from this (modulo a suitable criterion for continuity
based on sequences convergence, established in \verb+continuous_at_extension_sequentially'+).›
definition Gromov_extension::"('a::Gromov_hyperbolic_space ⇒ 'b::Gromov_hyperbolic_space) ⇒ ('a Gromov_completion ⇒ 'b Gromov_completion)"
where "Gromov_extension f x = (if x ∈ Gromov_boundary then lim (to_Gromov_completion o f o (rep_Gromov_completion x))
else to_Gromov_completion (f (from_Gromov_completion x)))"
lemma Gromov_extension_inside_space [simp]:
"Gromov_extension f (to_Gromov_completion x) = to_Gromov_completion (f x)"
unfolding Gromov_extension_def by auto
lemma Gromov_extension_id [simp]:
"Gromov_extension (id::'a::Gromov_hyperbolic_space ⇒ 'a) = id"
"Gromov_extension (λx::'a. x) = (λx. x)"
proof -
have "Gromov_extension id x = id x" for x::"'a Gromov_completion"
unfolding Gromov_extension_def comp_def
using limI rep_Gromov_completion_limit by (auto simp add: to_from_Gromov_completion)
then show "Gromov_extension (id::'a ⇒ 'a) = id"
by auto
then show "Gromov_extension (λx::'a. x) = (λx. x)"
unfolding id_def by auto
qed
text ‹The Gromov extension of a quasi-isometric map sends the boundary to the boundary.›
lemma Gromov_extension_quasi_isometry_boundary_to_boundary:
fixes f::"'a::Gromov_hyperbolic_space_geodesic ⇒ 'b::Gromov_hyperbolic_space_geodesic"
assumes "lambda C-quasi_isometry f"
"x ∈ Gromov_boundary"
shows "(Gromov_extension f) x ∈ Gromov_boundary"
proof -
have *: "Gromov_converging_at_boundary (λn. f (rep_Gromov_completion x n))"
by (simp add: Gromov_converging_at_infinity_quasi_isometry[OF assms(1)] Gromov_boundary_rep_converging assms(2))
show ?thesis
unfolding Gromov_extension_def using assms(2) unfolding comp_def apply auto
by (metis Gromov_converging_at_boundary_converges * limI)
qed
text ‹If the original function is continuous somewhere inside the space, then its Gromov extension
is continuous at the corresponding point inside the completion. This is clear as the original space
is open in the Gromov completion, but the proof requires to go back and forth between one space
and the other.›
lemma Gromov_extension_continuous_inside:
fixes f::"'a::Gromov_hyperbolic_space ⇒ 'b::Gromov_hyperbolic_space"
assumes "continuous (at x within S) f"
shows "continuous (at (to_Gromov_completion x) within (to_Gromov_completion`S)) (Gromov_extension f)"
proof -
have *: "continuous (at (to_Gromov_completion x) within (to_Gromov_completion`S)) (to_Gromov_completion o f o from_Gromov_completion)"
apply (intro continuous_within_compose, auto)
using from_Gromov_completion_continuous(3) continuous_at_imp_continuous_within apply blast
using assms apply (simp add: continuous_within_topological)
using continuous_at_imp_continuous_within continuous_on_eq_continuous_within to_Gromov_completion_continuous by blast
have "(to_Gromov_completion o f o from_Gromov_completion) y = Gromov_extension f y"
if "y ∈ range to_Gromov_completion" for y
unfolding comp_def using that by auto
moreover have "eventually (λy. y ∈ range to_Gromov_completion) (at (to_Gromov_completion x) within (to_Gromov_completion`S))"
using to_Gromov_completion_range_open eventually_at_topological by blast
ultimately have **: "eventually (λy. (to_Gromov_completion o f o from_Gromov_completion) y = Gromov_extension f y)
(at (to_Gromov_completion x) within (to_Gromov_completion`S))"
by (rule eventually_mono[rotated])
show ?thesis
by (rule continuous_within_cong[OF * **], auto)
qed
text ‹The extension to the boundary of a quasi-isometry is continuous. This is a nontrivial
statement, but it follows readily from the fact we have already proved that sequences converging
at the boundary are mapped to sequences converging to the boundary. The proof is expressed using
a convenient continuity criterion for which we only need to control what happens for sequences
inside the space.›
proposition Gromov_extension_continuous:
fixes f::"'a::Gromov_hyperbolic_space_geodesic ⇒ 'b::Gromov_hyperbolic_space_geodesic"
assumes "lambda C-quasi_isometry f"
"x ∈ Gromov_boundary"
shows "continuous (at x) (Gromov_extension f)"
proof -
have "continuous (at x within (range to_Gromov_completion ∪ Gromov_boundary)) (Gromov_extension f)"
proof (rule continuous_at_extension_sequentially'[OF ‹x ∈ Gromov_boundary›])
fix b::"'a Gromov_completion" assume "b ∈ Gromov_boundary"
show "∃u. (∀n. u n ∈ range to_Gromov_completion) ∧ u ⇢ b ∧ (λn. Gromov_extension f (u n)) ⇢ Gromov_extension f b"
apply (rule exI[of _ "to_Gromov_completion o (rep_Gromov_completion b)"], auto simp add: comp_def)
unfolding Gromov_completion_converge_to_boundary[OF ‹b ∈ Gromov_boundary›]
using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion] apply auto[1]
unfolding Gromov_extension_def using ‹b ∈ Gromov_boundary› unfolding comp_def
by (auto simp add: convergent_LIMSEQ_iff[symmetric] Gromov_boundary_rep_converging Gromov_converging_at_infinity_quasi_isometry[OF assms(1)]
intro!: Gromov_converging_at_boundary_converges')
next
fix u and b::"'a Gromov_completion"
assume u: "∀n. u n ∈ range to_Gromov_completion" "b ∈ Gromov_boundary" "u ⇢ b"
define v where "v = (λn. from_Gromov_completion (u n))"
have v: "u n = to_Gromov_completion (v n)" for n
using u(1) unfolding v_def by (simp add: f_inv_into_f from_Gromov_completion_def)
show "convergent (λn. Gromov_extension f (u n))"
using u unfolding v
apply (auto intro!: Gromov_converging_at_boundary_converges' simp add: Gromov_converging_at_infinity_quasi_isometry[OF assms(1)])
using Gromov_boundary_abs_converging Gromov_completion_converge_to_boundary by blast
qed
then show ?thesis by (simp add: Gromov_boundary_def)
qed
text ‹Combining the two previous statements on continuity inside the space and continuity at the
boundary, we deduce that a continuous quasi-isometry extends to a continuous map everywhere.›
proposition Gromov_extension_continuous_everywhere:
fixes f::"'a::Gromov_hyperbolic_space_geodesic ⇒ 'b::Gromov_hyperbolic_space_geodesic"
assumes "lambda C-quasi_isometry f"
"continuous_on UNIV f"
shows "continuous_on UNIV (Gromov_extension f)"
using Gromov_extension_continuous_inside Gromov_extension_continuous[OF assms(1)]
by (metis UNIV_I assms(2) continuous_on_eq_continuous_within continuous_within_open not_in_Gromov_boundary rangeI to_Gromov_completion_range_open)
text ‹The extension to the boundary is functorial on the category of quasi-isometries, i.e., the
composition of extensions is the extension of the composition. This is clear inside the space, and
it follows from the continuity at boundary points.›
lemma Gromov_extension_composition:
fixes f::"'a::Gromov_hyperbolic_space_geodesic ⇒ 'b::Gromov_hyperbolic_space_geodesic"
and g::"'b::Gromov_hyperbolic_space_geodesic ⇒ 'c::Gromov_hyperbolic_space_geodesic"
assumes "lambda C-quasi_isometry f"
"mu D-quasi_isometry g"
shows "Gromov_extension (g o f) = Gromov_extension g o Gromov_extension f"
proof -
have In: "Gromov_extension (g o f) x = (Gromov_extension g o Gromov_extension f) x" if H: "x ∈ range to_Gromov_completion" for x
proof -
obtain y where *: "x = to_Gromov_completion y"
using H by auto
show ?thesis
unfolding * comp_def by auto
qed
moreover have "Gromov_extension (g o f) x = (Gromov_extension g o Gromov_extension f) x" if H: "x ∈ Gromov_boundary" for x
proof -
obtain u where u: "⋀n. u n ∈ range to_Gromov_completion" "u ⇢ x"
using closure_sequential to_Gromov_completion_range_dense by blast
have "(λn. Gromov_extension (g o f) (u n)) ⇢ Gromov_extension (g o f) x"
using continuous_within_tendsto_compose[OF Gromov_extension_continuous[OF quasi_isometry_on_compose[OF assms(1) assms(2), simplified] H] _ u(2)] by simp
then have A: "(λn. (Gromov_extension g) ((Gromov_extension f) (u n))) ⇢ Gromov_extension (g o f) x"
unfolding In[OF u(1)] unfolding comp_def by auto
have *: "(λn. (Gromov_extension f) (u n)) ⇢ (Gromov_extension f) x"
using continuous_within_tendsto_compose[OF Gromov_extension_continuous[OF assms(1) H] _ u(2)] by simp
have "(λn. (Gromov_extension g) ((Gromov_extension f) (u n))) ⇢ Gromov_extension g ((Gromov_extension f) x)"
using continuous_within_tendsto_compose[OF Gromov_extension_continuous[OF assms(2)] _ *]
H Gromov_extension_quasi_isometry_boundary_to_boundary assms(1) by auto
then show ?thesis using LIMSEQ_unique A comp_def by auto
qed
ultimately have "Gromov_extension (g o f) x = (Gromov_extension g o Gromov_extension f) x" for x
using not_in_Gromov_boundary by force
then show ?thesis by auto
qed
text ‹Now, we turn to the same kind of statement, but for homeomorphisms. We claim that if a
quasi-isometry $f$ is a homeomorphism on a subset $X$ of the space, then its extension is a
homeomorphism on $X$ union the boundary of the space.
For the proof, we have to show that a sequence $u_n$ tends to a point $x$
if and only if $f(u_n)$ tends to $f(x)$. We separate the cases $x$ in the boundary, and $x$ inside
the space. For $x$ in the boundary, we use a homeomorphism criterion expressed solely in terms
of sequences converging to the boundary, for which we already know everything.
For $x$ in the space, the proof is straightforward, but tedious.
We argue that eventually $u_n$ is in the space for the direct implication, or $f(u_n)$ is in the
space for the second implication, and then we use that $f$ is a homeomorphism inside the space to
conclude.›
lemma Gromov_extension_homeomorphism:
fixes f::"'a::Gromov_hyperbolic_space_geodesic ⇒ 'b::Gromov_hyperbolic_space_geodesic"
assumes "lambda C-quasi_isometry f"
"homeomorphism_on X f"
shows "homeomorphism_on (to_Gromov_completion`X ∪ Gromov_boundary) (Gromov_extension f)"
proof (rule homeomorphism_on_sequentially)
fix x u assume H0: "x ∈ to_Gromov_completion ` X ∪ Gromov_boundary"
"∀n::nat. u n ∈ to_Gromov_completion ` X ∪ Gromov_boundary"
then consider "x ∈ Gromov_boundary" | "x ∈ to_Gromov_completion`X" by auto
then show "u ⇢ x = (λn. Gromov_extension f (u n)) ⇢ Gromov_extension f x"
proof (cases)
text ‹First, consider the case where the limit point $x$ is in the boundary. We use a good
criterion expressing everything in terms of sequences inside the space.›
case 1
show ?thesis
proof (rule homeomorphism_on_extension_sequentially_precise[of "range to_Gromov_completion" Gromov_boundary])
show "x ∈ Gromov_boundary" by fact
fix n::nat show "u n ∈ range to_Gromov_completion ∪ Gromov_boundary"
unfolding Gromov_boundary_def by auto
next
fix u and b::"'a Gromov_completion"
assume u: "∀n. u n ∈ range to_Gromov_completion" "b ∈ Gromov_boundary" "u ⇢ b"
define v where "v = (λn. from_Gromov_completion (u n))"
have v: "u n = to_Gromov_completion (v n)" for n
using u(1) unfolding v_def by (simp add: f_inv_into_f from_Gromov_completion_def)
show "convergent (λn. Gromov_extension f (u n))"
using u unfolding v apply auto
apply (rule Gromov_converging_at_boundary_converges')
by (auto simp add: Gromov_converging_at_infinity_quasi_isometry[OF assms(1)] lim_imp_Gromov_converging_at_boundary)
next
fix u c
assume u: "∀n. u n ∈ range to_Gromov_completion" "c ∈ Gromov_extension f ` Gromov_boundary" "(λn. Gromov_extension f (u n)) ⇢ c"
then have "c ∈ Gromov_boundary" using Gromov_extension_quasi_isometry_boundary_to_boundary[OF assms(1)] by auto
define v where "v = (λn. from_Gromov_completion (u n))"
have v: "u n = to_Gromov_completion (v n)" for n
using u(1) unfolding v_def by (simp add: f_inv_into_f from_Gromov_completion_def)
have "Gromov_converging_at_boundary (λn. f (v n))"
apply (rule lim_imp_Gromov_converging_at_boundary[OF _ ‹c ∈ Gromov_boundary›])
using u(3) unfolding v by auto
then show "convergent u"
using u unfolding v
by (auto intro!: Gromov_converging_at_boundary_converges' simp add: Gromov_converging_at_infinity_quasi_isometry[OF assms(1), symmetric])
next
fix b::"'a Gromov_completion" assume "b ∈ Gromov_boundary"
show "∃u. (∀n. u n ∈ range to_Gromov_completion) ∧ u ⇢ b ∧ (λn. Gromov_extension f (u n)) ⇢ Gromov_extension f b"
apply (rule exI[of _ "to_Gromov_completion o (rep_Gromov_completion b)"], auto simp add: comp_def)
unfolding Gromov_completion_converge_to_boundary[OF ‹b ∈ Gromov_boundary›]
using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion] apply auto[1]
unfolding Gromov_extension_def using ‹b ∈ Gromov_boundary› unfolding comp_def
by (auto simp add: convergent_LIMSEQ_iff[symmetric] Gromov_boundary_rep_converging Gromov_converging_at_infinity_quasi_isometry[OF assms(1)]
intro!: Gromov_converging_at_boundary_converges')
qed
next
text ‹Next, consider the case where $x$ is inside the space. Then we show everything by going
back and forth between the original space and its copy in the completion, and arguing that $f$
is a homeomorphism on the original space.›
case 2
then have fx: "Gromov_extension f x ∈ range to_Gromov_completion"
using Gromov_extension_inside_space by blast
have x: "x ∈ range to_Gromov_completion"
using "2" by blast
show ?thesis
proof
assume H: "(λn. Gromov_extension f (u n)) ⇢ Gromov_extension f x"
then have fu_in: "eventually (λn. Gromov_extension f (u n) ∈ range to_Gromov_completion) sequentially"
using fx to_Gromov_completion_range_open H topological_tendstoD by fastforce
have u_in: "eventually (λn. u n ∈ range to_Gromov_completion) sequentially"
using Gromov_extension_quasi_isometry_boundary_to_boundary[OF assms(1)] eventually_mono[OF fu_in]
by (metis DiffE DiffI Gromov_boundary_def iso_tuple_UNIV_I)
have B: "from_Gromov_completion (Gromov_extension f y) = f (from_Gromov_completion y)" if "Gromov_extension f y ∈ range to_Gromov_completion" for y
by (metis Gromov_extension_quasi_isometry_boundary_to_boundary Gromov_extension_def assms(1) from_to_Gromov_completion not_in_Gromov_boundary' rangeE that)
have "(λn. from_Gromov_completion (Gromov_extension f (u n))) ⇢ from_Gromov_completion (Gromov_extension f x)"
by (rule continuous_on_tendsto_compose[OF from_Gromov_completion_continuous(2) H fx fu_in])
then have C: "(λn. f (from_Gromov_completion (u n))) ⇢ f (from_Gromov_completion x)"
unfolding B[OF fx, symmetric]
by (force intro: Lim_transform_eventually eventually_mono[OF fu_in B])
have "(λn. from_Gromov_completion (u n)) ⇢ from_Gromov_completion x"
apply (rule iffD2[OF homeomorphism_on_compose[OF assms(2)] C])
using 2 apply auto
by (metis (no_types, lifting) eventually_mono[OF u_in] H0(2) Un_iff f_inv_into_f from_to_Gromov_completion inv_into_into not_in_Gromov_boundary')
then have L: "(λn. to_Gromov_completion (from_Gromov_completion (u n))) ⇢ to_Gromov_completion (from_Gromov_completion x)"
using continuous_on_tendsto_compose[OF to_Gromov_completion_continuous] by auto
have **: "to_Gromov_completion (from_Gromov_completion y) = y" if "y ∈ range to_Gromov_completion" for y::"'a Gromov_completion"
using Gromov_extension_quasi_isometry_boundary_to_boundary assms(1) that to_from_Gromov_completion by fastforce
then have "eventually (λn. to_Gromov_completion (from_Gromov_completion (u n)) = u n) sequentially"
using u_in eventually_mono by force
then have "u ⇢ to_Gromov_completion (from_Gromov_completion x)"
by (rule Lim_transform_eventually[OF L])
then show "u ⇢ x"
using ** by (simp add: x)
next
assume "u ⇢ x"
then have u_in: "eventually (λn. u n ∈ range to_Gromov_completion) sequentially"
using x to_Gromov_completion_range_open topological_tendstoD by fastforce
define y where "y = from_Gromov_completion x"
have "y ∈ X" unfolding y_def using 2 by auto
then have *: "continuous (at y within X) f"
using homeomorphism_on_continuous[OF assms(2)] continuous_on_eq_continuous_within by blast
have **: "continuous (at x within to_Gromov_completion`X) (Gromov_extension f)"
using Gromov_extension_continuous_inside[OF *] y_def 2 by auto
show "(λn. Gromov_extension f (u n)) ⇢ Gromov_extension f x"
apply (rule continuous_within_tendsto_compose[OF ** _ ‹u ⇢ x›])
using u_in H0(2) by (metis (mono_tags, lifting) UnE eventually_mono f_inv_into_f not_in_Gromov_boundary')
qed
qed
qed
text ‹In particular, it follows that the extension to the boundary of a quasi-isometry is always
a homeomorphism, regardless of the continuity properties of the original map.›
proposition Gromov_extension_boundary_homeomorphism:
fixes f::"'a::Gromov_hyperbolic_space_geodesic ⇒ 'b::Gromov_hyperbolic_space_geodesic"
assumes "lambda C-quasi_isometry f"
shows "homeomorphism_on Gromov_boundary (Gromov_extension f)"
using Gromov_extension_homeomorphism[OF assms, of "{}"] by auto
text ‹When the quasi-isometric embedding is a quasi-isometric isomorphism, i.e., it is onto up
to a bounded distance $C$, then its Gromov extension is onto on the boundary. Indeed, a point
in the image boundary is a limit of a sequence inside the space. Perturbing by a bounded distance
(which does not change the asymptotic behavior), it is the limit of a sequence inside the image of
$f$. Then the preimage under $f$ of this sequence does converge, and its limit is sent by the
extension on the original point, proving the surjectivity.›
lemma Gromov_extension_onto:
fixes f::"'a::Gromov_hyperbolic_space_geodesic ⇒ 'b::Gromov_hyperbolic_space_geodesic"
assumes "lambda C-quasi_isometry_between UNIV UNIV f"
"y ∈ Gromov_boundary"
shows "∃x ∈ Gromov_boundary. Gromov_extension f x = y"
proof -
define u where "u = rep_Gromov_completion y"
have *: "(λn. to_Gromov_completion (u n)) ⇢ y"
unfolding u_def using rep_Gromov_completion_limit by fastforce
have "∃v. ∀n. dist (f (v n)) (u n) ≤ C"
apply (intro choice) using quasi_isometry_betweenD(3)[OF assms(1)] by auto
then obtain v where v: "⋀n. dist (f (v n)) (u n) ≤ C" by auto
have *: "(λn. to_Gromov_completion (f (v n))) ⇢ y"
apply (rule Gromov_converging_at_boundary_bounded_perturbation[OF * ‹y ∈ Gromov_boundary›])
using v by (simp add: dist_commute)
then have "Gromov_converging_at_boundary (λn. f (v n))"
using assms(2) lim_imp_Gromov_converging_at_boundary by force
then have "Gromov_converging_at_boundary v"
using Gromov_converging_at_infinity_quasi_isometry[OF quasi_isometry_betweenD(1)[OF assms(1)]] by auto
then obtain x where "x ∈ Gromov_boundary" "(λn. to_Gromov_completion (v n)) ⇢ x"
using Gromov_converging_at_boundary_converges by blast
then have "(λn. (Gromov_extension f) (to_Gromov_completion (v n))) ⇢ Gromov_extension f x"
using isCont_tendsto_compose[OF Gromov_extension_continuous[OF quasi_isometry_betweenD(1)[OF assms(1)] ‹x ∈ Gromov_boundary›]] by fastforce
then have "y = Gromov_extension f x"
using * LIMSEQ_unique by auto
then show ?thesis using ‹x ∈ Gromov_boundary› by auto
qed
lemma Gromov_extension_onto':
fixes f::"'a::Gromov_hyperbolic_space_geodesic ⇒ 'b::Gromov_hyperbolic_space_geodesic"
assumes "lambda C-quasi_isometry_between UNIV UNIV f"
shows "(Gromov_extension f)`Gromov_boundary = Gromov_boundary"
using Gromov_extension_onto[OF assms] Gromov_extension_quasi_isometry_boundary_to_boundary[OF quasi_isometry_betweenD(1)[OF assms]] by auto
text ‹Finally, we obtain that a quasi-isometry between two Gromov hyperbolic spaces induces a
homeomorphism of their boundaries.›
theorem Gromov_boundaries_homeomorphic:
fixes f::"'a::Gromov_hyperbolic_space_geodesic ⇒ 'b::Gromov_hyperbolic_space_geodesic"
assumes "lambda C-quasi_isometry_between UNIV UNIV f"
shows "(Gromov_boundary::'a Gromov_completion set) homeomorphic (Gromov_boundary::'b Gromov_completion set)"
using Gromov_extension_boundary_homeomorphism[OF quasi_isometry_betweenD(1)[OF assms]] Gromov_extension_onto'[OF assms]
unfolding homeomorphic_def homeomorphism_on_def by auto
section ‹Extensions of isometries to the boundary›
text ‹The results of the previous section can be improved for isometries, as there is no need for
geodesicity any more. We follow the same proofs as in the previous section›
text ‹An isometry preserves the Gromov product.›
lemma Gromov_product_isometry:
assumes "isometry_on UNIV f"
shows "Gromov_product_at (f x) (f y) (f z) = Gromov_product_at x y z"
unfolding Gromov_product_at_def by (simp add: isometry_onD[OF assms])
text ‹An isometry preserves convergence at infinity.›
lemma Gromov_converging_at_infinity_isometry:
fixes f::"'a::Gromov_hyperbolic_space ⇒ 'b::Gromov_hyperbolic_space"
assumes "isometry_on UNIV f"
shows "Gromov_converging_at_boundary (λn. f (u n)) ⟷ Gromov_converging_at_boundary u"
proof
assume *: "Gromov_converging_at_boundary u"
show "Gromov_converging_at_boundary (λn. f (u n))"
apply (rule Gromov_converging_at_boundaryI[of "f (basepoint)"])
using * unfolding Gromov_converging_at_boundary_def Gromov_product_isometry[OF assms] by auto
next
assume *: "Gromov_converging_at_boundary (λn. f (u n))"
have **: "∃N. ∀n ≥ N. ∀m ≥ N. M ≤ Gromov_product_at (f basepoint) (f (u m)) (f (u n))" for M
using * unfolding Gromov_converging_at_boundary_def by auto
show "Gromov_converging_at_boundary u"
apply (rule Gromov_converging_at_boundaryI[of "basepoint"])
using ** unfolding Gromov_converging_at_boundary_def Gromov_product_isometry[OF assms] by auto
qed
text ‹The Gromov extension of an isometry sends the boundary to the boundary.›
lemma Gromov_extension_isometry_boundary_to_boundary:
fixes f::"'a::Gromov_hyperbolic_space ⇒ 'b::Gromov_hyperbolic_space"
assumes "isometry_on UNIV f"
"x ∈ Gromov_boundary"
shows "(Gromov_extension f) x ∈ Gromov_boundary"
proof -
have *: "Gromov_converging_at_boundary (λn. f (rep_Gromov_completion x n))"
by (simp add: Gromov_converging_at_infinity_isometry[OF assms(1)] Gromov_boundary_rep_converging assms(2))
show ?thesis
unfolding Gromov_extension_def using assms(2) unfolding comp_def apply auto
by (metis Gromov_converging_at_boundary_converges * limI)
qed
text ‹The Gromov extension of an isometry is a homeomorphism. (We copy the proof for
quasi-isometries, with some simplifications.)›
lemma Gromov_extension_isometry_homeomorphism:
fixes f::"'a::Gromov_hyperbolic_space ⇒ 'b::Gromov_hyperbolic_space"
assumes "isometry_on UNIV f"
shows "homeomorphism_on UNIV (Gromov_extension f)"
proof (rule homeomorphism_on_sequentially)
fix x u
show "u ⇢ x = (λn. Gromov_extension f (u n)) ⇢ Gromov_extension f x"
proof (cases x)
text ‹First, consider the case where the limit point $x$ is in the boundary. We use a good
criterion expressing everything in terms of sequences inside the space.›
case boundary
show ?thesis
proof (rule homeomorphism_on_extension_sequentially_precise[of "range to_Gromov_completion" Gromov_boundary])
show "x ∈ Gromov_boundary" by fact
fix n::nat show "u n ∈ range to_Gromov_completion ∪ Gromov_boundary"
unfolding Gromov_boundary_def by auto
next
fix u and b::"'a Gromov_completion"
assume u: "∀n. u n ∈ range to_Gromov_completion" "b ∈ Gromov_boundary" "u ⇢ b"
define v where "v = (λn. from_Gromov_completion (u n))"
have v: "u n = to_Gromov_completion (v n)" for n
using u(1) unfolding v_def by (simp add: f_inv_into_f from_Gromov_completion_def)
show "convergent (λn. Gromov_extension f (u n))"
using u unfolding v apply auto
apply (rule Gromov_converging_at_boundary_converges')
by (auto simp add: Gromov_converging_at_infinity_isometry[OF assms(1)] lim_imp_Gromov_converging_at_boundary)
next
fix u c
assume u: "∀n. u n ∈ range to_Gromov_completion" "c ∈ Gromov_extension f ` Gromov_boundary" "(λn. Gromov_extension f (u n)) ⇢ c"
then have "c ∈ Gromov_boundary" using Gromov_extension_isometry_boundary_to_boundary[OF assms(1)] by auto
define v where "v = (λn. from_Gromov_completion (u n))"
have v: "u n = to_Gromov_completion (v n)" for n
using u(1) unfolding v_def by (simp add: f_inv_into_f from_Gromov_completion_def)
have "Gromov_converging_at_boundary (λn. f (v n))"
apply (rule lim_imp_Gromov_converging_at_boundary[OF _ ‹c ∈ Gromov_boundary›])
using u(3) unfolding v by auto
then show "convergent u"
using u unfolding v
by (auto intro!: Gromov_converging_at_boundary_converges' simp add: Gromov_converging_at_infinity_isometry[OF assms(1), symmetric])
next
fix b::"'a Gromov_completion" assume "b ∈ Gromov_boundary"
show "∃u. (∀n. u n ∈ range to_Gromov_completion) ∧ u ⇢ b ∧ (λn. Gromov_extension f (u n)) ⇢ Gromov_extension f b"
apply (rule exI[of _ "to_Gromov_completion o (rep_Gromov_completion b)"], auto simp add: comp_def)
unfolding Gromov_completion_converge_to_boundary[OF ‹b ∈ Gromov_boundary›]
using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion] apply auto[1]
unfolding Gromov_extension_def using ‹b ∈ Gromov_boundary› unfolding comp_def
by (auto simp add: convergent_LIMSEQ_iff[symmetric] Gromov_boundary_rep_converging Gromov_converging_at_infinity_isometry[OF assms(1)]
intro!: Gromov_converging_at_boundary_converges')
qed
next
text ‹Next, consider the case where $x$ is inside the space. Then we show everything by going
back and forth between the original space and its copy in the completion, and arguing that $f$
is a homeomorphism on the original space.›
case (to_Gromov_completion xin)
then have fx: "Gromov_extension f x ∈ range to_Gromov_completion"
using Gromov_extension_inside_space by blast
have x: "x ∈ range to_Gromov_completion"
using to_Gromov_completion by blast
show ?thesis
proof
assume H: "(λn. Gromov_extension f (u n)) ⇢ Gromov_extension f x"
then have fu_in: "eventually (λn. Gromov_extension f (u n) ∈ range to_Gromov_completion) sequentially"
using fx to_Gromov_completion_range_open H topological_tendstoD by fastforce
have u_in: "eventually (λn. u n ∈ range to_Gromov_completion) sequentially"
using Gromov_extension_isometry_boundary_to_boundary[OF assms(1)] eventually_mono[OF fu_in]
by (metis DiffE DiffI Gromov_boundary_def iso_tuple_UNIV_I)
have B: "from_Gromov_completion (Gromov_extension f y) = f (from_Gromov_completion y)" if "Gromov_extension f y ∈ range to_Gromov_completion" for y
by (metis Gromov_extension_isometry_boundary_to_boundary Gromov_extension_def assms(1) from_to_Gromov_completion not_in_Gromov_boundary' rangeE that)
have "(λn. from_Gromov_completion (Gromov_extension f (u n))) ⇢ from_Gromov_completion (Gromov_extension f x)"
by (rule continuous_on_tendsto_compose[OF from_Gromov_completion_continuous(2) H fx fu_in])
then have C: "(λn. f (from_Gromov_completion (u n))) ⇢ f (from_Gromov_completion x)"
unfolding B[OF fx, symmetric]
by (force intro: Lim_transform_eventually eventually_mono[OF fu_in B])
have "(λn. from_Gromov_completion (u n)) ⇢ from_Gromov_completion x"
apply (rule iffD2[OF homeomorphism_on_compose[OF isometry_on_homeomorphism(2)[OF assms]] C])
using to_Gromov_completion by auto
then have L: "(λn. to_Gromov_completion (from_Gromov_completion (u n))) ⇢ to_Gromov_completion (from_Gromov_completion x)"
using continuous_on_tendsto_compose[OF to_Gromov_completion_continuous] by auto
have **: "to_Gromov_completion (from_Gromov_completion y) = y" if "y ∈ range to_Gromov_completion" for y::"'a Gromov_completion"
using Gromov_extension_isometry_boundary_to_boundary assms(1) that to_from_Gromov_completion by fastforce
then have "eventually (λn. to_Gromov_completion (from_Gromov_completion (u n)) = u n) sequentially"
using u_in eventually_mono by force
then have "u ⇢ to_Gromov_completion (from_Gromov_completion x)"
by (rule Lim_transform_eventually[OF L])
then show "u ⇢ x"
using ** by (simp add: x)
next
assume "u ⇢ x"
then have u_in: "eventually (λn. u n ∈ range to_Gromov_completion) sequentially"
using x to_Gromov_completion_range_open topological_tendstoD by fastforce
define y where "y = from_Gromov_completion x"
then have *: "continuous (at y) f"
using homeomorphism_on_continuous[OF isometry_on_homeomorphism(2)[OF assms]] continuous_on_eq_continuous_within by blast
have **: "continuous (at x within to_Gromov_completion`UNIV) (Gromov_extension f)"
using Gromov_extension_continuous_inside[OF *] y_def to_Gromov_completion by auto
show "(λn. Gromov_extension f (u n)) ⇢ Gromov_extension f x"
apply (rule continuous_within_tendsto_compose[OF ** _ ‹u ⇢ x›])
using u_in by auto
qed
qed
qed
text ‹The composition of the Gromov extension of two isometries is the Gromov extension of the
composition.›
lemma Gromov_extension_isometry_on_composition:
assumes "isometry_on UNIV f"
"isometry_on UNIV g"
shows "Gromov_extension (g o f) = Gromov_extension g o Gromov_extension f"
proof -
have In: "Gromov_extension (g o f) x = (Gromov_extension g o Gromov_extension f) x" if H: "x ∈ range to_Gromov_completion" for x
proof -
obtain y where *: "x = to_Gromov_completion y"
using H by auto
show ?thesis
unfolding * comp_def by auto
qed
moreover have "Gromov_extension (g o f) x = (Gromov_extension g o Gromov_extension f) x" if H: "x ∈ Gromov_boundary" for x
proof -
obtain u where u: "⋀n. u n ∈ range to_Gromov_completion" "u ⇢ x"
using closure_sequential to_Gromov_completion_range_dense by blast
have "(λn. Gromov_extension (g o f) (u n)) ⇢ Gromov_extension (g o f) x"
apply (rule continuous_within_tendsto_compose[OF _ _ u(2), of UNIV])
using homeomorphism_on_continuous[OF Gromov_extension_isometry_homeomorphism[OF isometry_on_compose[OF assms(1) isometry_on_subset[OF assms(2)]]]] unfolding comp_def
by (auto simp add: continuous_on_eq_continuous_within)
then have A: "(λn. (Gromov_extension g) ((Gromov_extension f) (u n))) ⇢ Gromov_extension (g o f) x"
unfolding In[OF u(1)] unfolding comp_def by auto
have *: "(λn. (Gromov_extension f) (u n)) ⇢ (Gromov_extension f) x"
apply (rule continuous_within_tendsto_compose[OF _ _ u(2), of UNIV])
using homeomorphism_on_continuous[OF Gromov_extension_isometry_homeomorphism[OF assms(1)]] unfolding comp_def
by (auto simp add: continuous_on_eq_continuous_within)
have "(λn. (Gromov_extension g) ((Gromov_extension f) (u n))) ⇢ Gromov_extension g ((Gromov_extension f) x)"
apply (rule continuous_within_tendsto_compose[OF _ _ *, of UNIV])
using homeomorphism_on_continuous[OF Gromov_extension_isometry_homeomorphism[OF assms(2)]] unfolding comp_def
by (auto simp add: continuous_on_eq_continuous_within)
then show ?thesis using LIMSEQ_unique A comp_def by auto
qed
ultimately have "Gromov_extension (g o f) x = (Gromov_extension g o Gromov_extension f) x" for x
using not_in_Gromov_boundary by force
then show ?thesis by auto
qed
text ‹We specialize the previous results to bijective isometries, as this is the setting where they
will be used most of the time.›
lemma Gromov_extension_isometry:
assumes "isometry f"
shows "homeomorphism_on UNIV (Gromov_extension f)"
"continuous_on UNIV (Gromov_extension f)"
"continuous (at x) (Gromov_extension f)"
using Gromov_extension_isometry_homeomorphism[OF isometryD(1)[OF assms]] homeomorphism_on_continuous apply auto
using ‹homeomorphism_on UNIV (Gromov_extension f)› continuous_on_eq_continuous_within homeomorphism_on_continuous by blast
lemma Gromov_extension_isometry_composition:
assumes "isometry f"
"isometry g"
shows "Gromov_extension (g o f) = Gromov_extension g o Gromov_extension f"
using Gromov_extension_isometry_on_composition[OF isometryD(1)[OF assms(1)] isometryD(1)[OF assms(2)]] by simp
lemma Gromov_extension_isometry_iterates:
fixes f::"'a ⇒ ('a::Gromov_hyperbolic_space)"
assumes "isometry f"
shows "Gromov_extension (f^^n) = (Gromov_extension f)^^n"
apply (induction n) using Gromov_extension_isometry_composition[OF isometry_iterates[OF assms] assms] unfolding comp_def by auto
lemma Gromov_extension_isometry_inv:
assumes "isometry f"
shows "inv (Gromov_extension f) = Gromov_extension (inv f)"
"bij (Gromov_extension f)"
proof -
have *: "(inv f) o f = id"
using isometry_inverse(2)[OF assms] by (simp add: bij_is_inj)
have "Gromov_extension ((inv f) o f) = Gromov_extension (inv f) o Gromov_extension f"
by (rule Gromov_extension_isometry_composition[OF assms isometry_inverse(1)[OF assms]])
then have A: "Gromov_extension (inv f) o Gromov_extension f = id"
unfolding * by auto
have *: "f o (inv f) = id"
using isometry_inverse(2)[OF assms] by (meson bij_is_surj surj_iff)
have "Gromov_extension (f o (inv f)) = Gromov_extension f o Gromov_extension (inv f)"
by (rule Gromov_extension_isometry_composition[OF isometry_inverse(1)[OF assms] assms])
then have B: "Gromov_extension f o Gromov_extension (inv f) = id"
unfolding * by auto
show "bij (Gromov_extension f)"
using A B unfolding bij_def apply auto
by (metis inj_on_id inj_on_imageI2, metis B comp_apply id_def rangeI)
show "inv (Gromov_extension f) = Gromov_extension (inv f)"
using B ‹bij (Gromov_extension f)› bij_is_inj inv_o_cancel left_right_inverse_eq by blast
qed
text ‹We will especially use fixed points on the boundary. We note that if a point is fixed by
(the Gromov extension of) a map, then it is fixed by (the Gromov extension of) its inverse.›
lemma Gromov_extension_inv_fixed_point:
assumes "isometry (f::'a::Gromov_hyperbolic_space ⇒ 'a)" "Gromov_extension f xi = xi"
shows "Gromov_extension (inv f) xi = xi"
by (metis Gromov_extension_isometry_inv(1) Gromov_extension_isometry_inv(2) assms(1) assms(2) bij_betw_def inv_f_f)
text ‹The extended Gromov product is invariant under isometries. This follows readily from the
definition, but still the proof is not fully automatic, unfortunately.›
lemma Gromov_extension_preserves_extended_Gromov_product:
assumes "isometry f"
shows "extended_Gromov_product_at (f x) (Gromov_extension f xi) (Gromov_extension f eta) = extended_Gromov_product_at x xi eta"
proof -
have "{liminf (λn. ereal (Gromov_product_at (f x) (u n) (v n))) |u v.
(λn. to_Gromov_completion (u n)) ⇢ Gromov_extension f xi ∧ (λn. to_Gromov_completion (v n)) ⇢ Gromov_extension f eta} =
{liminf (λn. ereal (Gromov_product_at x (u n) (v n))) |u v.
(λn. to_Gromov_completion (u n)) ⇢ xi ∧ (λn. to_Gromov_completion (v n)) ⇢ eta}"
proof (auto)
fix u v assume H: "(λn. to_Gromov_completion (u n)) ⇢ Gromov_extension f xi"
"(λn. to_Gromov_completion (v n)) ⇢ Gromov_extension f eta"
define u' where "u' = (λn. (inv f) (u n))"
define v' where "v' = (λn. (inv f) (v n))"
have "(λn. to_Gromov_completion (u' n)) ⇢ Gromov_extension (inv f) (Gromov_extension f xi)"
unfolding u'_def Gromov_extension_inside_space[symmetric]
apply (rule iffD1[OF homeomorphism_on_compose[OF Gromov_extension_isometry_homeomorphism[OF isometryD(1)[OF isometry_inverse(1)[OF assms]]]]])
using H(1) by auto
moreover have "Gromov_extension (inv f) (Gromov_extension f xi) = xi"
using Gromov_extension_isometry_composition[OF assms isometry_inverse(1)[OF assms], symmetric] unfolding comp_def
using bij_is_inj[OF isometry_inverse(2)[OF assms]]
by (simp add: ‹Gromov_extension (inv f) ∘ Gromov_extension f = Gromov_extension (inv f ∘ f)› pointfree_idE)
ultimately have U: "(λn. to_Gromov_completion (u' n)) ⇢ xi" by simp
have "(λn. to_Gromov_completion (v' n)) ⇢ Gromov_extension (inv f) (Gromov_extension f eta)"
unfolding v'_def Gromov_extension_inside_space[symmetric]
apply (rule iffD1[OF homeomorphism_on_compose[OF Gromov_extension_isometry_homeomorphism[OF isometryD(1)[OF isometry_inverse(1)[OF assms]]]]])
using H(2) by auto
moreover have "Gromov_extension (inv f) (Gromov_extension f eta) = eta"
using Gromov_extension_isometry_composition[OF assms isometry_inverse(1)[OF assms], symmetric] unfolding comp_def
using bij_is_inj[OF isometry_inverse(2)[OF assms]]
by (simp add: ‹Gromov_extension (inv f) ∘ Gromov_extension f = Gromov_extension (inv f ∘ f)› pointfree_idE)
ultimately have V: "(λn. to_Gromov_completion (v' n)) ⇢ eta" by simp
have uv: "u n = f (u' n)" "v n = f (v' n)" for n
unfolding u'_def v'_def by (auto simp add: assms isometryD(3) surj_f_inv_f)
have "Gromov_product_at (f x) (u n) (v n) = Gromov_product_at x (u' n) (v' n)" for n
unfolding uv using assms by (simp add: Gromov_product_isometry isometry_def)
then have "liminf (λn. ereal (Gromov_product_at (f x) (u n) (v n))) = liminf (λn. ereal (Gromov_product_at x (u' n) (v' n)))"
by auto
then show "∃u' v'.
liminf (λn. ereal (Gromov_product_at (f x) (u n) (v n))) = liminf (λn. ereal (Gromov_product_at x (u' n) (v' n))) ∧
(λn. to_Gromov_completion (u' n)) ⇢ xi ∧ (λn. to_Gromov_completion (v' n)) ⇢ eta"
using U V by blast
next
fix u v assume H: "(λn. to_Gromov_completion (u n)) ⇢ xi"
"(λn. to_Gromov_completion (v n)) ⇢ eta"
define u' where "u' = (λn. f (u n))"
define v' where "v' = (λn. f (v n))"
have U: "(λn. to_Gromov_completion (u' n)) ⇢ Gromov_extension f xi"
unfolding u'_def Gromov_extension_inside_space[symmetric]
apply (rule iffD1[OF homeomorphism_on_compose[OF Gromov_extension_isometry_homeomorphism[OF isometryD(1)[OF assms]]]])
using H(1) by auto
have V: "(λn. to_Gromov_completion (v' n)) ⇢ Gromov_extension f eta"
unfolding v'_def Gromov_extension_inside_space[symmetric]
apply (rule iffD1[OF homeomorphism_on_compose[OF Gromov_extension_isometry_homeomorphism[OF isometryD(1)[OF assms]]]])
using H(2) by auto
have "Gromov_product_at (f x) (u' n) (v' n) = Gromov_product_at x (u n) (v n)" for n
unfolding u'_def v'_def using assms by (simp add: Gromov_product_isometry isometry_def)
then have "liminf (λn. ereal (Gromov_product_at x (u n) (v n))) = liminf (λn. ereal (Gromov_product_at (f x) (u' n) (v' n)))"
by auto
then show "∃u' v'.
liminf (λn. ereal (Gromov_product_at x (u n) (v n))) = liminf (λn. ereal (Gromov_product_at (f x) (u' n) (v' n))) ∧
(λn. to_Gromov_completion (u' n)) ⇢ Gromov_extension f xi ∧ (λn. to_Gromov_completion (v' n)) ⇢ Gromov_extension f eta"
using U V by auto
qed
then show ?thesis
unfolding extended_Gromov_product_at_topological by auto
qed
end
Theory Busemann_Function
section ‹Busemann functions›
theory Busemann_Function
imports Boundary_Extension Ergodic_Theory.Fekete
begin
text ‹The Busemann function $B_\xi(x,y)$ measures the difference $d(\xi, x) - d(\xi, y)$, where $\xi$
is a point at infinity and $x$ and $y$ are inside a Gromov hyperbolic space. This is not well defined
in this way, as we are subtracting two infinities, but one can make sense of this difference by
considering the behavior along a sequence tending to $\xi$. The limit may depend on the sequence, but
as usual in Gromov hyperbolic spaces it only depends on the sequence up to a uniform constant. Thus,
we may define the Busemann function using for instance the supremum of the limsup over all possible
sequences -- other choices would give rise to equivalent definitions, up to some multiple of
$\delta$.›
definition Busemann_function_at::"('a::Gromov_hyperbolic_space) Gromov_completion ⇒ 'a ⇒ 'a ⇒ real"
where "Busemann_function_at xi x y = real_of_ereal (
Sup {limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. (λn. to_Gromov_completion (u n)) ⇢ xi})"
text ‹Since limsups are only defined for complete orders currently, the definition goes through
ereals, and we go back to reals afterwards. However, there is no real difficulty here, as eveything
is bounded above and below (by $d(x,y)$ and $-d(x,y)$ respectively.›
lemma Busemann_function_ereal:
"ereal(Busemann_function_at xi x y) = Sup {limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. (λn. to_Gromov_completion (u n)) ⇢ xi}"
proof -
have A: "Sup {limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. (λn. to_Gromov_completion (u n)) ⇢ xi} ≤ dist x y"
by (rule Sup_least, auto intro!: Limsup_bounded always_eventually mono_intros simp add: algebra_simps)
have B: "Sup {limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. (λn. to_Gromov_completion (u n)) ⇢ xi} ≥ -dist x y"
proof -
obtain u where *: "(λn. to_Gromov_completion (u n)) ⇢ xi"
using rep_Gromov_completion_limit[of xi] by blast
have "ereal(-dist x y) ≤ limsup (λn. ereal(dist x (u n) - dist y (u n)))"
by (rule le_Limsup, auto intro!: always_eventually mono_intros simp add: algebra_simps)
also have "... ≤ Sup {limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. (λn. to_Gromov_completion (u n)) ⇢ xi}"
apply (rule Sup_upper) using * by auto
finally show ?thesis by simp
qed
show ?thesis
unfolding Busemann_function_at_def apply (rule ereal_real') using A B by auto
qed
text ‹If $\xi$ is not at infinity, then the Busemann function is simply the difference of the
distances.›
lemma Busemann_function_inner:
"Busemann_function_at (to_Gromov_completion z) x y = dist x z - dist y z"
proof -
have L: "limsup (λn. ereal(dist x (u n) - dist y (u n))) = dist x z - dist y z" if "u ⇢ z" for u
by (rule lim_imp_Limsup, simp, intro tendsto_intros that)
have "Sup {limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. u ⇢ z}
= dist x z - dist y z"
proof -
obtain u where u: "u ⇢ z"
by auto
show ?thesis
apply (rule order.antisym)
apply (subst Sup_le_iff) using L apply auto[1]
apply (subst L[OF u, symmetric]) apply (rule Sup_upper) using u by auto
qed
then have "ereal (Busemann_function_at (to_Gromov_completion z) x y) = dist x z - dist y z"
unfolding Busemann_function_ereal by auto
then show ?thesis by auto
qed
text ‹The Busemann function measured at the same points vanishes.›
lemma Busemann_function_xx [simp]:
"Busemann_function_at xi x x = 0"
proof -
have *: "{limsup (λn. ereal(dist x (u n) - dist x (u n))) |u. (λn. to_Gromov_completion (u n)) ⇢ xi} = {0}"
by (auto simp add: zero_ereal_def[symmetric] intro!: lim_imp_Limsup rep_Gromov_completion_limit[of xi])
have "ereal (Busemann_function_at xi x x) = ereal 0"
unfolding Busemann_function_ereal * by auto
then show ?thesis
by auto
qed
text ‹Perturbing the points gives rise to a variation of the Busemann function bounded by the
size of the variations. This is obvious for inner Busemann functions, and everything passes
readily to the limit.›
lemma Busemann_function_mono [mono_intros]:
"Busemann_function_at xi x y ≤ Busemann_function_at xi x' y' + dist x x' + dist y y'"
proof -
have A: "limsup (λn. ereal (dist x (u n) - dist y (u n)))
≤ ereal(Busemann_function_at xi x' y') + ereal (dist x x' + dist y y')"
if "(λn. to_Gromov_completion (u n)) ⇢ xi" for u
proof -
have *: "dist x z + dist y' z ≤ dist x x' + (dist y y' + (dist x' z + dist y z))" for z
using add_mono[OF dist_triangle[of x z x'] dist_triangle[of y' z y]] dist_commute[of y y'] by auto
have "limsup (λn. ereal (dist x (u n) - dist y (u n))) + (- ereal (dist x x' + dist y y'))
= limsup (λn. ereal (dist x (u n) - dist y (u n)) + (- ereal (dist x x' + dist y y')))"
by (rule Limsup_add_ereal_right[symmetric], auto)
also have "... ≤ limsup (λn. ereal (dist x' (u n) - dist y' (u n)))"
by (auto intro!: Limsup_mono always_eventually simp: algebra_simps *)
also have "... ≤ Sup {limsup (λn. ereal (dist x' (u n) - dist y' (u n))) |u. (λn. to_Gromov_completion (u n)) ⇢ xi}"
apply (rule Sup_upper) using that by auto
finally have "limsup (λn. ereal (dist x (u n) - dist y (u n))) + (- ereal (dist x x' + dist y y'))
≤ ereal(Busemann_function_at xi x' y')"
unfolding Busemann_function_ereal by auto
then show ?thesis
unfolding minus_ereal_def[symmetric] by (subst ereal_minus_le[symmetric], auto)
qed
have "ereal (Busemann_function_at xi x y) ≤ ereal(Busemann_function_at xi x' y') + dist x x' + dist y y'"
unfolding Busemann_function_ereal[of xi x y] using A by (auto intro!: Sup_least simp: algebra_simps)
then show ?thesis by simp
qed
text ‹In particular, it follows that the Busemann function $B_\xi(x,y)$ is bounded in absolute value
by $d(x,y)$.›
lemma Busemann_function_le_dist [mono_intros]:
"abs(Busemann_function_at xi x y) ≤ dist x y"
using Busemann_function_mono[of xi x y y y] Busemann_function_mono[of xi x x x y] by auto
lemma Busemann_function_Lipschitz [mono_intros]:
"abs(Busemann_function_at xi x y - Busemann_function_at xi x' y') ≤ dist x x' + dist y y'"
using Busemann_function_mono[of xi x y x' y'] Busemann_function_mono[of xi x' y' x y] by (simp add: dist_commute)
text ‹By the very definition of the Busemann function, the difference of distance functions is
bounded above by the Busemann function when one converges to $\xi$.›
lemma Busemann_function_limsup:
assumes "(λn. to_Gromov_completion (u n)) ⇢ xi"
shows "limsup (λn. dist x (u n) - dist y (u n)) ≤ Busemann_function_at xi x y"
unfolding Busemann_function_ereal apply (rule Sup_upper) using assms by auto
text ‹There is also a corresponding bound below, but with the loss of a constant. This follows
from the hyperbolicity of the space and a simple computation.›
lemma Busemann_function_liminf:
assumes "(λn. to_Gromov_completion (u n)) ⇢ xi"
shows "Busemann_function_at xi x y ≤ liminf (λn. dist (x::'a::Gromov_hyperbolic_space) (u n) - dist y (u n)) + 2 * deltaG(TYPE('a))"
proof (cases xi)
case (to_Gromov_completion z)
have *: "liminf (λn. dist x (u n) - dist y (u n)) = dist x z - dist y z"
apply (rule lim_imp_Liminf, simp, intro tendsto_intros)
using assms unfolding to_Gromov_completion by auto
show ?thesis
unfolding to_Gromov_completion plus_ereal.simps(1)[symmetric] Busemann_function_inner * by auto
next
case boundary
have I: "limsup (λn. ereal(dist x (v n) - dist y (v n))) ≤ liminf (λn. ereal(dist x (u n) - dist y (u n))) + 2 * deltaG(TYPE('a))"
if v: "(λn. to_Gromov_completion (v n)) ⇢ xi" for v
proof -
obtain N where N: "⋀m n. m ≥ N ⟹ n ≥ N ⟹ Gromov_product_at x (u m) (v n) ≥ dist x y"
using same_limit_imp_Gromov_product_tendsto_infinity[OF boundary assms v] by blast
have A: "dist x (v n) - dist y (v n) - 2 * deltaG(TYPE('a)) ≤ dist x (u m) - dist y (u m)" if "m ≥ N" "n ≥ N" for m n
proof -
have "Gromov_product_at x (v n) y ≤ dist x y"
by (intro mono_intros)
then have "min (Gromov_product_at x (u m) (v n)) (Gromov_product_at x (v n) y) = Gromov_product_at x (v n) y"
using N[OF ‹m ≥ N› ‹n ≥ N›] by linarith
moreover have "Gromov_product_at x (u m) y ≥ min (Gromov_product_at x (u m) (v n)) (Gromov_product_at x (v n) y) - deltaG(TYPE('a))"
by (intro mono_intros)
ultimately have "Gromov_product_at x (u m) y ≥ Gromov_product_at x (v n) y - deltaG(TYPE('a))"
by auto
then show ?thesis
unfolding Gromov_product_at_def by (auto simp add: algebra_simps divide_simps dist_commute)
qed
have B: "dist x (v n) - dist y (v n) - 2 * deltaG(TYPE('a)) ≤ liminf (λm. dist x (u m) - dist y (u m))" if "n ≥ N" for n
apply (rule Liminf_bounded) using A[OF _ that] unfolding eventually_sequentially by auto
have C: "dist x (v n) - dist y (v n) ≤ liminf (λm. dist x (u m) - dist y (u m)) + 2 * deltaG(TYPE('a))" if "n ≥ N" for n
using B[OF that] by (subst ereal_minus_le[symmetric], auto)
show ?thesis
apply (rule Limsup_bounded) unfolding eventually_sequentially apply (rule exI[of _ N]) using C by auto
qed
show ?thesis
unfolding Busemann_function_ereal apply (rule Sup_least) using I by auto
qed
text ‹To avoid formulating things in terms of liminf and limsup on ereal, the following formulation
of the two previous lemmas is useful.›
lemma Busemann_function_inside_approx:
assumes "e > (0::real)" "(λn. to_Gromov_completion (t n::'a::Gromov_hyperbolic_space)) ⇢ xi"
shows "eventually (λn. Busemann_function_at (to_Gromov_completion (t n)) x y ≤ Busemann_function_at xi x y + e
∧ Busemann_function_at (to_Gromov_completion (t n)) x y ≥ Busemann_function_at xi x y - 2 * deltaG(TYPE('a)) - e) sequentially"
proof -
have A: "eventually (λn. Busemann_function_at (to_Gromov_completion (t n)) x y < Busemann_function_at xi x y + ereal e) sequentially"
apply (rule Limsup_lessD)
unfolding Busemann_function_inner using le_less_trans[OF Busemann_function_limsup[OF assms(2)]] ‹e > 0› by auto
have B: "eventually (λn. Busemann_function_at (to_Gromov_completion (t n)) x y > Busemann_function_at xi x y -2 * deltaG(TYPE('a)) - ereal e) sequentially"
apply (rule less_LiminfD)
unfolding Busemann_function_inner using less_le_trans[OF _ Busemann_function_liminf[OF assms(2)], of "ereal(Busemann_function_at xi x y) - ereal e" x y] ‹e > 0› apply auto
apply (unfold ereal_minus(1)[symmetric], subst ereal_minus_less_iff, simp)+
unfolding ereal_minus(1)[symmetric] by (simp only: ereal_minus_less_iff, auto simp add: algebra_simps)
show ?thesis
by (rule eventually_mono[OF eventually_conj[OF A B]], auto)
qed
text ‹The Busemann function is essentially a morphism, i.e., it should satisfy $B_\xi(x,z) =
B_\xi(x,y) + B_\xi(y,z)$, as it is defined as a difference of distances. This is not exactly
the case as there is a choice in the definition, but it is the case up to a uniform constant,
as we show in the next few lemmas. One says that it is a~\emph{quasi-morphism}.›
lemma Busemann_function_triangle [mono_intros]:
"Busemann_function_at xi x z ≤ Busemann_function_at xi x y + Busemann_function_at xi y z"
proof -
have "limsup (λn. dist x (u n) - dist z (u n)) ≤ Busemann_function_at xi x y + Busemann_function_at xi y z"
if "(λn. to_Gromov_completion (u n)) ⇢ xi" for u
proof -
have "limsup (λn. dist x (u n) - dist z (u n)) = limsup (λn. ereal (dist x (u n) - dist y (u n)) + (dist y (u n) - dist z (u n)))"
by auto
also have "... ≤ limsup (λn. dist x (u n) - dist y (u n)) + limsup (λn. dist y (u n) - dist z (u n))"
by (rule ereal_limsup_add_mono)
also have "... ≤ ereal(Busemann_function_at xi x y) + Busemann_function_at xi y z"
unfolding Busemann_function_ereal using that by (auto intro!: add_mono Sup_upper)
finally show ?thesis by auto
qed
then have "ereal (Busemann_function_at xi x z) ≤ Busemann_function_at xi x y + Busemann_function_at xi y z"
unfolding Busemann_function_ereal[of xi x z] by (auto intro!: Sup_least)
then show ?thesis
by auto
qed
lemma Busemann_function_xy_yx [mono_intros]:
"Busemann_function_at xi x y + Busemann_function_at xi y (x::'a::Gromov_hyperbolic_space) ≤ 2 * deltaG(TYPE('a))"
proof -
have *: "- liminf (λn. ereal (dist y (u n) - dist x (u n))) ≤ ereal (2 * deltaG TYPE('a) - Busemann_function_at xi y x)"
if "(λn. to_Gromov_completion (u n)) ⇢ xi" for u
using Busemann_function_liminf[of _ xi y x, OF that] ereal_minus_le_minus_plus unfolding ereal_minus(1)[symmetric]
by fastforce
have "ereal (Busemann_function_at xi x y) = Sup {limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. (λn. to_Gromov_completion (u n)) ⇢ xi}"
unfolding Busemann_function_ereal by auto
also have "... = Sup {limsup (λn. - ereal(dist y (u n) - dist x (u n))) |u. (λn. to_Gromov_completion (u n)) ⇢ xi}"
by auto
also have "... = Sup {- liminf (λn. ereal(dist y (u n) - dist x (u n))) |u. (λn. to_Gromov_completion (u n)) ⇢ xi}"
unfolding ereal_Limsup_uminus by auto
also have "... ≤ 2 * deltaG(TYPE('a)) - ereal(Busemann_function_at xi y x)"
by (auto intro!: Sup_least *)
finally show ?thesis
by simp
qed
theorem Busemann_function_quasi_morphism [mono_intros]:
"¦Busemann_function_at xi x y + Busemann_function_at xi y z - Busemann_function_at xi x (z::'a::Gromov_hyperbolic_space)¦ ≤ 2 * deltaG(TYPE('a))"
using Busemann_function_triangle[of xi x z y] Busemann_function_triangle[of xi x y z] Busemann_function_xy_yx[of xi y z] by auto
text ‹The extended Gromov product can be bounded from below by the Busemann function.›
lemma Busemann_function_le_Gromov_product:
"- Busemann_function_at xi y x/2 ≤ extended_Gromov_product_at x xi (to_Gromov_completion y)"
proof -
have A: "-ereal(Busemann_function_at xi y x/2) ≤ liminf (λn. Gromov_product_at x (u n) y)"
if "(λn. to_Gromov_completion (u n)) ⇢ xi" for u
proof -
have *: "limsup (λn. - ereal (Gromov_product_at x (u n) y) * 2) ≤ limsup (λn. ereal (dist y (u n) - dist x (u n)))"
by (auto intro!: Limsup_mono always_eventually simp: algebra_simps Gromov_product_at_def divide_simps dist_commute)
also have "... ≤ ereal(Busemann_function_at xi y x)"
unfolding Busemann_function_ereal using that by (auto intro!: Sup_upper)
finally have "-ereal(Busemann_function_at xi y x) ≤ liminf (λn. Gromov_product_at x (u n) y) * ereal 2"
apply (subst ereal_uminus_le_reorder, subst ereal_mult_minus_left[symmetric], subst ereal_Limsup_uminus[symmetric])
by (subst limsup_ereal_mult_right[symmetric], auto)
moreover have "-ereal(z/2) ≤ t" if "-ereal z ≤ t * ereal 2" for z t
proof -
have *: "-ereal(z/2) = -ereal z / ereal 2"
unfolding ereal_divide by auto
have "0 < ereal 2"
by auto
then show ?thesis unfolding * using that
by (metis (no_types) PInfty_neq_ereal(2) ereal_divide_le_posI ereal_uminus_eq_iff mult.commute that)
qed
ultimately show ?thesis by auto
qed
show ?thesis
unfolding extended_Gromov_product_at_def proof (rule Inf_greatest, auto)
fix u v assume uv: "xi = abs_Gromov_completion u" "abs_Gromov_completion v = to_Gromov_completion y" "Gromov_completion_rel u u" "Gromov_completion_rel v v"
then have L: "(λn. to_Gromov_completion (u n)) ⇢ xi"
using abs_Gromov_completion_limit by auto
have *: "v n = y" for n
using uv by (metis (mono_tags, hide_lams) Gromov_completion_rel_def Quotient3_Gromov_completion Quotient3_rep_abs abs_Gromov_completion_in_Gromov_boundary not_in_Gromov_boundary' rep_Gromov_completion_to_Gromov_completion)
show "ereal (- (Busemann_function_at (abs_Gromov_completion u) y x / 2)) ≤ liminf (λn. ereal (Gromov_product_at x (u n) (v n)))"
unfolding uv(1)[symmetric] * using A[OF L] by simp
qed
qed
text ‹It follows that, if the Busemann function tends to minus infinity, i.e., the distance to
$\xi$ becomes smaller and smaller in a suitable sense, then the sequence is converging to $\xi$.
This is only an implication: one can have sequences tending to $\xi$ for which the Busemann function
does not tend to $-\infty$. This is in fact a stronger notion of convergence, sometimes called
radial convergence.›
proposition Busemann_function_minus_infinity_imp_convergent:
assumes "((λn. Busemann_function_at xi (u n) x) ⤏ -∞) F"
shows "((λn. to_Gromov_completion (u n)) ⤏ xi) F"
proof (cases "trivial_limit F")
case True
then show ?thesis by auto
next
case False
have "xi ∈ Gromov_boundary"
proof (cases xi)
case (to_Gromov_completion z)
then have "ereal(Busemann_function_at xi (u n) x) ≥ - dist x z" for n
unfolding to_Gromov_completion Busemann_function_inner by auto
then have "-∞ ≥ -dist x z"
using tendsto_lowerbound[OF assms always_eventually False] by metis
then have False
by auto
then show ?thesis by auto
qed
have "((λn. - ereal (Busemann_function_at xi (u n) x) / 2) ⤏ (- (-∞)/2)) F"
apply (intro tendsto_intros) using assms by auto
then have *: "((λn. - ereal (Busemann_function_at xi (u n) x) / 2) ⤏ ∞) F"
by auto
have **: "((λn. extended_Gromov_product_at x xi (to_Gromov_completion (u n))) ⤏ ∞) F"
apply (rule tendsto_sandwich[of "λn. - ereal (Busemann_function_at xi (u n) x) / 2" _ _ "λn. ∞", OF always_eventually always_eventually])
using Busemann_function_le_Gromov_product[of xi _ x] * by auto
show ?thesis
using extended_Gromov_product_tendsto_PInf_a_b[OF **, of basepoint]
by (auto simp add: Gromov_completion_boundary_limit[OF ‹xi ∈ Gromov_boundary›] extended_Gromov_product_at_commute)
qed
text ‹Busemann functions are invariant under isometries. This is trivial as everything is defined
in terms of the distance, but the definition in terms of supremum and limsups makes the proof
tedious.›
lemma Busemann_function_isometry:
assumes "isometry f"
shows "Busemann_function_at (Gromov_extension f xi) (f x) (f y) = Busemann_function_at xi x y"
proof -
have "{limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. (λn. to_Gromov_completion (u n)) ⇢ xi}
= {limsup (λn. ereal(dist (f x) (v n) - dist (f y) (v n))) |v. (λn. to_Gromov_completion (v n)) ⇢ Gromov_extension f xi}"
proof (auto)
fix u assume u: "(λn. to_Gromov_completion (u n)) ⇢ xi"
define v where "v = f o u"
have "(λn. to_Gromov_completion (v n)) ⇢ Gromov_extension f xi"
unfolding v_def comp_def Gromov_extension_inside_space[symmetric] using u Gromov_extension_isometry(2)[OF ‹isometry f›]
by (metis continuous_on filterlim_compose iso_tuple_UNIV_I tendsto_at_iff_tendsto_nhds)
moreover have "limsup (λn. ereal (dist x (u n) - dist y (u n))) = limsup (λn. ereal (dist (f x) (v n) - dist (f y) (v n)))"
unfolding v_def comp_def isometryD(2)[OF ‹isometry f›] by simp
ultimately show "∃v. limsup (λn. ereal (dist x (u n) - dist y (u n))) = limsup (λn. ereal (dist (f x) (v n) - dist (f y) (v n))) ∧
(λn. to_Gromov_completion (v n)) ⇢ Gromov_extension f xi"
by blast
next
fix v assume v: "(λn. to_Gromov_completion (v n)) ⇢ Gromov_extension f xi"
define u where "u = (inv f) o v"
have "isometry (inv f)"
using isometry_inverse(1)[OF ‹isometry f›] by simp
have *: "inv f (f z) = z" for z
using isometry_inverse(2)[OF ‹isometry f›] by (simp add: bij_betw_def)
have **: "(Gromov_extension (inv f) (Gromov_extension f xi)) = xi"
using Gromov_extension_isometry_composition[OF ‹isometry f› ‹isometry (inv f)›]
unfolding comp_def using isometry_inverse(2)[OF ‹isometry f›] by (auto simp: *, metis)
have "(λn. to_Gromov_completion (u n)) ⇢ Gromov_extension (inv f) (Gromov_extension f xi)"
unfolding u_def comp_def Gromov_extension_inside_space[symmetric] using v Gromov_extension_isometry(2)[OF ‹isometry (inv f)›]
by (metis continuous_on filterlim_compose iso_tuple_UNIV_I tendsto_at_iff_tendsto_nhds)
then have "(λn. to_Gromov_completion (u n)) ⇢ xi"
using ** by auto
moreover have "limsup (λn. ereal (dist ((inv f) (f x)) (u n) - dist ((inv f) (f y)) (u n))) = limsup (λn. ereal (dist (f x) (v n) - dist (f y) (v n)))"
unfolding u_def comp_def isometryD(2)[OF ‹isometry (inv f)›] by simp
ultimately show "∃u. limsup (λn. ereal (dist (f x) (v n) - dist (f y) (v n))) = limsup (λn. ereal (dist x (u n) - dist y (u n))) ∧ (λn. to_Gromov_completion (u n)) ⇢ xi"
by (simp add: *, force)
qed
then have "ereal (Busemann_function_at xi x y) = ereal (Busemann_function_at (Gromov_extension f xi) (f x) (f y))"
unfolding Busemann_function_ereal by auto
then show ?thesis by auto
qed
lemma dist_le_max_Busemann_functions [mono_intros]:
assumes "xi ≠ eta"
shows "dist x (y::'a::Gromov_hyperbolic_space) ≤ 2 * real_of_ereal (extended_Gromov_product_at y xi eta)
+ max (Busemann_function_at xi x y) (Busemann_function_at eta x y) + 2 * deltaG(TYPE('a))"
proof -
have A: "ereal(dist x y - 2 * deltaG(TYPE('a)) - max (Busemann_function_at xi x y) (Busemann_function_at eta x y)) / ereal 2 ≤
liminf (λn. ereal(Gromov_product_at y (u n) (v n)))"
if uv: "abs_Gromov_completion u = xi" "abs_Gromov_completion v = eta" "Gromov_completion_rel u u" "Gromov_completion_rel v v" for u v
proof -
have C: "(λn. to_Gromov_completion (u n)) ⇢ xi" "(λn. to_Gromov_completion (v n)) ⇢ eta"
using uv abs_Gromov_completion_limit by auto
have "ereal(dist x y) ≤ ereal(2 * Gromov_product_at y (u n) (v n)) + 2 * deltaG(TYPE('a)) + max (ereal(dist x (u n) - dist y (u n))) (ereal(dist x (v n) - dist y (v n)))" for n
proof -
have "min (Gromov_product_at y (u n) x) (Gromov_product_at y x (v n)) ≤ Gromov_product_at y (u n) (v n) + deltaG(TYPE('a))"
by (intro mono_intros)
then consider "Gromov_product_at y (u n) x ≤ Gromov_product_at y (u n) (v n) + deltaG(TYPE('a))"|"Gromov_product_at y x (v n) ≤ Gromov_product_at y (u n) (v n) + deltaG(TYPE('a))"
by linarith
then have "dist x y ≤ 2 * Gromov_product_at y (u n) (v n) + 2 * deltaG(TYPE('a)) + max (dist x (u n) - dist y (u n)) (dist x (v n) - dist y (v n))"
unfolding Gromov_product_at_def[of _ x] Gromov_product_at_def[of _ _ x] apply (cases)
by (auto simp add: algebra_simps divide_simps dist_commute)
then show ?thesis
unfolding ereal_max[symmetric] plus_ereal.simps(1) by auto
qed
then have "ereal (dist x y) ≤ liminf (λn. ereal(2 * Gromov_product_at y (u n) (v n)) + 2 * deltaG(TYPE('a)) + max (ereal(dist x (u n) - dist y (u n))) (ereal(dist x (v n) - dist y (v n))))"
by (intro Liminf_bounded always_eventually, auto)
also have "... ≤ liminf (λn. ereal(2 * Gromov_product_at y (u n) (v n)) + 2 * deltaG(TYPE('a))) + limsup (λn. max (ereal(dist x (u n) - dist y (u n))) (ereal(dist x (v n) - dist y (v n))))"
by (rule ereal_liminf_limsup_add)
also have "... = liminf (λn. ereal(2 * Gromov_product_at y (u n) (v n))) + 2 * deltaG(TYPE('a)) + max (limsup (λn. ereal(dist x (u n) - dist y (u n)))) (limsup (λn. ereal(dist x (v n) - dist y (v n))))"
apply (subst Liminf_add_ereal_right) by (auto simp add: Limsup_max_eq_max_Limsup)
also have "... ≤ liminf (λn. ereal(2 * Gromov_product_at y (u n) (v n))) + 2 * deltaG(TYPE('a)) + max (ereal(Busemann_function_at xi x y)) (Busemann_function_at eta x y)"
unfolding Busemann_function_ereal apply (intro mono_intros Sup_upper) using C by auto
finally have "ereal(dist x y) - ereal(2 * deltaG(TYPE('a)) + max (Busemann_function_at xi x y) (Busemann_function_at eta x y)) ≤
liminf (λn. ereal(2 * Gromov_product_at y (u n) (v n)))"
unfolding ereal_max[symmetric] add.assoc plus_ereal.simps(1) by (subst ereal_minus_le, auto)
then have "ereal(dist x y - 2 * deltaG(TYPE('a)) - max (Busemann_function_at xi x y) (Busemann_function_at eta x y)) ≤
liminf (λn. ereal(2 * Gromov_product_at y (u n) (v n)))"
unfolding ereal_minus(1) by (auto simp add: algebra_simps)
also have "... = ereal 2 * liminf (λn. ereal(Gromov_product_at y (u n) (v n)))"
unfolding times_ereal.simps(1)[symmetric] by (subst Liminf_ereal_mult_left, auto)
finally show ?thesis
by (subst ereal_divide_le_pos, auto)
qed
have "ereal(dist x y - 2 * deltaG(TYPE('a)) - max (Busemann_function_at xi x y) (Busemann_function_at eta x y)) / ereal 2 ≤
extended_Gromov_product_at y xi eta"
unfolding extended_Gromov_product_at_def apply (rule Inf_greatest) using A by auto
also have "... = ereal(real_of_ereal(extended_Gromov_product_at y xi eta))"
using assms by simp
finally show ?thesis
by simp
qed
lemma dist_minus_Busemann_max_ineq:
"dist (x::'a::Gromov_hyperbolic_space) z - Busemann_function_at xi z x ≤ max (dist x y - Busemann_function_at xi y x) (dist y z - Busemann_function_at xi z y - 2 * Busemann_function_at xi y x) + 8 * deltaG(TYPE('a))"
proof -
have I: "dist x z - Busemann_function_at (to_Gromov_completion t) z x ≤ max (dist x y - Busemann_function_at (to_Gromov_completion t) y x)
(dist y z - Busemann_function_at (to_Gromov_completion t) z y - 2 * Busemann_function_at (to_Gromov_completion t) y x)
+ 2 * deltaG(TYPE('a))" for t
proof -
have "2 * dist x t + - max (dist x y - Busemann_function_at (to_Gromov_completion t) y x) (dist y z - Busemann_function_at (to_Gromov_completion t) z y - 2 * Busemann_function_at (to_Gromov_completion t) y x)
= min (2 * dist x t - (dist x y - Busemann_function_at (to_Gromov_completion t) y x)) (2 * dist x t - (dist y z - Busemann_function_at (to_Gromov_completion t) z y - 2 * Busemann_function_at (to_Gromov_completion t) y x))"
unfolding minus_max_eq_min min_add_distrib_right by auto
also have "... = min (2 * Gromov_product_at t x y) (2 * Gromov_product_at t y z)"
apply (rule cong[of "min _" "min _"], rule cong [of min min])
unfolding Gromov_product_at_def Busemann_function_inner by (auto simp add: algebra_simps dist_commute divide_simps)
also have "... = 2 * (min (Gromov_product_at t x y) (Gromov_product_at t y z))"
by auto
also have "... ≤ 2 * (Gromov_product_at t x z + deltaG(TYPE('a)))"
by (intro mono_intros, auto)
also have "... = 2 * dist x t - (dist x z - Busemann_function_at (to_Gromov_completion t) z x) + 2 * deltaG(TYPE('a))"
unfolding Gromov_product_at_def Busemann_function_inner by (auto simp add: algebra_simps dist_commute divide_simps)
finally show ?thesis
by auto
qed
have "dist x z - Busemann_function_at xi z x ≤ max (dist x y - Busemann_function_at xi y x) (dist y z - Busemann_function_at xi z y - 2 * Busemann_function_at xi y x) + 8 * deltaG(TYPE('a)) + d"
if "d > 0" for d
proof -
define e where "e = d/4"
have "e > 0" unfolding e_def using that by auto
obtain t where t: "(λn. to_Gromov_completion (t n)) ⇢ xi"
using rep_Gromov_completion_limit by auto
have A: "eventually (λn. Busemann_function_at xi y x ≤ Busemann_function_at (to_Gromov_completion (t n)) y x + 2 * deltaG(TYPE('a)) + e) sequentially"
by (rule eventually_mono[OF Busemann_function_inside_approx[OF ‹e > 0› t, of y x]], auto)
have B: "eventually (λn. Busemann_function_at xi z y ≤ Busemann_function_at (to_Gromov_completion (t n)) z y + 2 * deltaG(TYPE('a)) + e) sequentially"
by (rule eventually_mono[OF Busemann_function_inside_approx[OF ‹e > 0› t, of z y]], auto)
have C: "eventually (λn. Busemann_function_at xi z x ≥ Busemann_function_at (to_Gromov_completion (t n)) z x - e) sequentially"
by (rule eventually_mono[OF Busemann_function_inside_approx[OF ‹e > 0› t, of z x]], auto)
obtain n where H: "Busemann_function_at xi y x ≤ Busemann_function_at (to_Gromov_completion (t n)) y x + 2 * deltaG(TYPE('a)) + e"
"Busemann_function_at xi z y ≤ Busemann_function_at (to_Gromov_completion (t n)) z y + 2 * deltaG(TYPE('a)) + e"
"Busemann_function_at xi z x ≥ Busemann_function_at (to_Gromov_completion (t n)) z x - e"
using eventually_conj[OF A eventually_conj[OF B C]] eventually_sequentially by auto
have "dist x z - Busemann_function_at xi z x - e ≤ dist x z - Busemann_function_at (to_Gromov_completion (t n)) z x"
using H by auto
also have "... ≤ max (dist x y - Busemann_function_at (to_Gromov_completion (t n)) y x)
(dist y z - Busemann_function_at (to_Gromov_completion (t n)) z y - 2 * Busemann_function_at (to_Gromov_completion (t n)) y x)
+ 2 * deltaG(TYPE('a))"
using I by auto
also have "... ≤ max (dist x y - (Busemann_function_at xi y x - 2 * deltaG(TYPE('a)) - e))
(dist y z - (Busemann_function_at xi z y - 2 * deltaG(TYPE('a)) - e) - 2 * (Busemann_function_at xi y x - 2 * deltaG(TYPE('a)) - e))
+ 2 * deltaG(TYPE('a))"
apply (intro mono_intros) using H by auto
also have "... ≤ max (dist x y - Busemann_function_at xi y x + 6 * deltaG(TYPE('a)) + 3 * e)
(dist y z - Busemann_function_at xi z y - 2 * Busemann_function_at xi y x + 6 * deltaG(TYPE('a)) + 3 * e)
+ 2 * deltaG(TYPE('a))"
apply (intro add_mono max.mono) using ‹e > 0› by auto
also have "... = max (dist x y - Busemann_function_at xi y x) (dist y z - Busemann_function_at xi z y - 2 * Busemann_function_at xi y x) + 8 * deltaG(TYPE('a)) + 3 * e"
by auto
finally show ?thesis unfolding e_def by auto
qed
then show ?thesis by (rule field_le_epsilon)
qed
end
Theory Isometries_Classification
section ‹Classification of isometries on a Gromov hyperbolic space›
theory Isometries_Classification
imports Gromov_Boundary Busemann_Function
begin
text ‹Isometries of Gromov hyperbolic spaces are of three types:
\begin{itemize}
\item Elliptic ones, for which orbits are bounded.
\item Parabolic ones, which are not elliptic and have exactly one fixed point
at infinity.
\item Loxodromic ones, which are not elliptic and have exactly two fixed points
at infinity.
\end{itemize}
In this file, we show that all isometries are indeed of this form, and give
further properties for each type.
For the definition, we use another characterization in terms of stable translation length: for
isometries which are not elliptic, then they are parabolic if the stable translation length is $0$,
loxodromic if it is positive. This gives a very efficient definition, and it is clear from this
definition that the three categories of isometries are disjoint. All the work is then to go from
this general definition to the dynamical properties in terms of fixed points on the boundary.
›
subsection ‹The translation length›
text ‹The translation length is the minimal translation distance of an isometry. The stable
translation length is the limit of the translation length of $f^n$ divided by $n$.›
definition translation_length::"(('a::metric_space) ⇒ 'a) ⇒ real"
where "translation_length f = Inf {dist x (f x)|x. True}"
lemma translation_length_nonneg [simp, mono_intros]:
"translation_length f ≥ 0"
unfolding translation_length_def by (rule cInf_greatest, auto)
lemma translation_length_le [mono_intros]:
"translation_length f ≤ dist x (f x)"
unfolding translation_length_def apply (rule cInf_lower) by (auto intro: bdd_belowI[of _ 0])
definition stable_translation_length::"(('a::metric_space) ⇒ 'a) ⇒ real"
where "stable_translation_length f = Inf {translation_length (f^^n)/n |n. n > 0}"
lemma stable_translation_length_nonneg [simp]:
"stable_translation_length f ≥ 0"
unfolding stable_translation_length_def by (rule cInf_greatest, auto)
lemma stable_translation_length_le_translation_length [mono_intros]:
"n * stable_translation_length f ≤ translation_length (f^^n)"
proof -
have *: "stable_translation_length f ≤ translation_length (f^^n)/n" if "n > 0" for n
unfolding stable_translation_length_def apply (rule cInf_lower) using that by (auto intro: bdd_belowI[of _ 0])
show ?thesis
apply (cases "n = 0") using * by (auto simp add: divide_simps algebra_simps)
qed
lemma semicontraction_iterates:
fixes f::"('a::metric_space) ⇒ 'a"
assumes "1-lipschitz_on UNIV f"
shows "1-lipschitz_on UNIV (f^^n)"
by (induction n, auto intro!: lipschitz_onI lipschitz_on_compose2[of 1 UNIV _ 1 f, simplified] lipschitz_on_subset[OF assms])
text ‹If $f$ is a semicontraction, then its stable translation length is the limit of $d(x, f^n x)/n$
for any $n$. While it is obvious that the liminf of this quantity is at least the stable translation
length (which is defined as an inf over all points and all times), the opposite inequality is more
interesting. One may find a point $y$ and a time $k$ for which $d(y, f^k y)/k$ is very close to the
stable translation length. By subadditivity of the sequence $n \mapsto f(y, f^n y)$ and Fekete's
Lemma, it follows that, for any large $n$, then $d(y, f^n y)/n$ is also very close to the stable
translation length. Since this is equal to $d(x, f^n x)/n$ up to $\pm 2 d(x,y)/n$, the result
follows.›
proposition stable_translation_length_as_pointwise_limit:
assumes "1-lipschitz_on UNIV f"
shows "(λn. dist x ((f^^n) x)/n) ⇢ stable_translation_length f"
proof -
have *: "subadditive (λn. dist y ((f^^n) y))" for y
proof (rule subadditiveI)
fix m n::nat
have "dist y ((f ^^ (m + n)) y) ≤ dist y ((f^^m) y) + dist ((f^^m) y) ((f^^(m+n)) y)"
by (rule dist_triangle)
also have "... = dist y ((f^^m) y) + dist ((f^^m) y) ((f^^m) ((f^^n) y))"
by (auto simp add: funpow_add)
also have "... ≤ dist y ((f^^m) y) + dist y ((f^^n) y)"
using semicontraction_iterates[OF assms, of m] unfolding lipschitz_on_def by auto
finally show "dist y ((f ^^ (m + n)) y) ≤ dist y ((f ^^ m) y) + dist y ((f ^^ n) y)"
by simp
qed
have Ly: "(λn. dist y ((f^^n) y) / n) ⇢ Inf {dist y ((f^^n) y) / n |n. n > 0}" for y
by (auto intro!: bdd_belowI[of _ 0] subadditive_converges_bounded'[OF subadditive_imp_eventually_subadditive[OF *]])
have "eventually (λn. dist x ((f^^n) x)/n < l) sequentially" if "stable_translation_length f < l" for l
proof -
obtain m where m: "stable_translation_length f < m" "m < l"
using ‹stable_translation_length f < l› dense by auto
have "∃t ∈ {translation_length (f^^n)/n |n. n > 0}. t < m"
apply (subst cInf_less_iff[symmetric])
using m unfolding stable_translation_length_def by (auto intro!: bdd_belowI[of _ 0])
then obtain k where k: "k > 0" "translation_length (f^^k)/k < m"
by auto
have "translation_length (f^^k) < k * m"
using k by (simp add: divide_simps algebra_simps)
then have "∃t ∈ {dist y ((f^^k) y) |y. True}. t < k * m"
apply (subst cInf_less_iff[symmetric])
unfolding translation_length_def by (auto intro!: bdd_belowI[of _ 0])
then obtain y where y: "dist y ((f^^k) y) < k * m"
by auto
have A: "eventually (λn. dist y ((f^^n) y)/n < m) sequentially"
apply (auto intro!: order_tendstoD[OF Ly] iffD2[OF cInf_less_iff] bdd_belowI[of _ 0] exI[of _ "dist y ((f^^k) y)/k"])
using y k by (auto simp add: algebra_simps divide_simps)
have B: "eventually (λn. dist x y * (1/n) < (l-m)/2) sequentially"
apply (intro order_tendstoD[of _ "dist x y * 0"] tendsto_intros)
using ‹m < l› by simp
have C: "dist x ((f^^n) x)/n < l" if "n > 0" "dist y ((f^^n) y)/n < m" "dist x y * (1/n) < (l-m)/2" for n
proof -
have "dist x ((f^^n) x) ≤ dist x y + dist y ((f^^n) y) + dist ((f^^n) y) ((f^^n) x)"
by (intro mono_intros)
also have "... ≤ dist x y + dist y ((f^^n) y) + dist y x"
using semicontraction_iterates[OF assms, of n] unfolding lipschitz_on_def by auto
also have "... = 2 * dist x y + dist y ((f^^n) y)"
by (simp add: dist_commute)
also have "... < 2 * real n * (l-m)/2 + n * m"
apply (intro mono_intros) using that by (auto simp add: algebra_simps divide_simps)
also have "... = n * l"
by (simp add: algebra_simps divide_simps)
finally show ?thesis
using that by (simp add: algebra_simps divide_simps)
qed
show "eventually (λn. dist x ((f^^n) x)/n < l) sequentially"
by (rule eventually_mono[OF eventually_conj[OF eventually_conj[OF A B] eventually_gt_at_top[of 0]] C], auto)
qed
moreover have "eventually (λn. dist x ((f^^n) x)/n > l) sequentially" if "stable_translation_length f > l" for l
proof -
have *: "dist x ((f^^n) x)/n > l" if "n > 0" for n
proof -
have "n * l < n * stable_translation_length f"
using ‹stable_translation_length f > l› ‹n > 0› by auto
also have "... ≤ translation_length (f^^n)"
by (intro mono_intros)
also have "... ≤ dist x ((f^^n) x)"
by (intro mono_intros)
finally show ?thesis
using ‹n > 0› by (auto simp add: algebra_simps divide_simps)
qed
then show ?thesis
by (rule eventually_mono[rotated], auto)
qed
ultimately show ?thesis
by (rule order_tendstoI[rotated])
qed
text ‹It follows from the previous proposition that the stable translation length is also the limit
of the renormalized translation length of $f^n$.›
proposition stable_translation_length_as_limit:
assumes "1-lipschitz_on UNIV f"
shows "(λn. translation_length (f^^n) / n) ⇢ stable_translation_length f"
proof -
obtain x::'a where True by auto
show ?thesis
proof (rule tendsto_sandwich[of "λn. stable_translation_length f" _ _ "λn. dist x ((f^^n) x)/n"])
have "stable_translation_length f ≤ translation_length (f ^^ n) / real n" if "n > 0" for n
using stable_translation_length_le_translation_length[of n f] that by (simp add: divide_simps algebra_simps)
then show "eventually (λn. stable_translation_length f ≤ translation_length (f ^^ n) / real n) sequentially"
by (rule eventually_mono[rotated], auto)
have "translation_length (f ^^ n) / real n ≤ dist x ((f ^^ n) x) / real n" for n
using translation_length_le[of "f^^n" x] by (auto simp add: divide_simps)
then show "eventually (λn. translation_length (f ^^ n) / real n ≤ dist x ((f ^^ n) x) / real n) sequentially"
by auto
qed (auto simp add: stable_translation_length_as_pointwise_limit[OF assms])
qed
lemma stable_translation_length_inv:
assumes "isometry f"
shows "stable_translation_length (inv f) = stable_translation_length f"
proof -
have *: "dist basepoint (((inv f)^^n) basepoint) = dist basepoint ((f^^n) basepoint)" for n
proof -
have "basepoint = (f^^n) (((inv f)^^n) basepoint)"
by (metis assms comp_apply fn_o_inv_fn_is_id isometry_inverse(2))
then have "dist basepoint ((f^^n) basepoint) = dist ((f^^n) (((inv f)^^n) basepoint)) ((f^^n) basepoint)"
by auto
also have "... = dist (((inv f)^^n) basepoint) basepoint"
unfolding isometryD(2)[OF isometry_iterates[OF assms]] by simp
finally show ?thesis by (simp add: dist_commute)
qed
have "(λn. dist basepoint ((f^^n) basepoint)/n) ⇢ stable_translation_length f"
using stable_translation_length_as_pointwise_limit[OF isometryD(4)[OF assms]] by simp
moreover have "(λn. dist basepoint ((f^^n) basepoint)/n) ⇢ stable_translation_length (inv f)"
unfolding *[symmetric]
using stable_translation_length_as_pointwise_limit[OF isometryD(4)[OF isometry_inverse(1)[OF assms]]] by simp
ultimately show ?thesis
using LIMSEQ_unique by auto
qed
subsection ‹The strength of an isometry at a fixed point at infinity›
text ‹The additive strength of an isometry at a fixed point at infinity is the asymptotic average
every point is moved towards the fixed point at each step. It is measured using the Busemann
function.›
definition additive_strength::"('a::Gromov_hyperbolic_space ⇒ 'a) ⇒ ('a Gromov_completion) ⇒ real"
where "additive_strength f xi = lim (λn. (Busemann_function_at xi ((f^^n) basepoint) basepoint)/n)"
text ‹For additivity reasons, as the Busemann function is a quasi-morphism, the additive strength
measures the deplacement even at finite times. It is also uniform in terms of the basepoint. This
shows that an isometry sends horoballs centered at a fixed point to horoballs, up to a uniformly
bounded error depending only on $\delta$.›
lemma Busemann_function_eq_additive_strength:
assumes "isometry f" "Gromov_extension f xi = xi"
shows "¦Busemann_function_at xi ((f^^n) x) (x::'a::Gromov_hyperbolic_space) - real n * additive_strength f xi¦ ≤ 2 * deltaG(TYPE('a))"
proof -
define u where "u = (λy n. Busemann_function_at xi ((f^^n) y) y)"
have *: "abs(u y (m+n) - u y m - u y n) ≤ 2 * deltaG(TYPE('a))" for n m y
proof -
have P: "Gromov_extension (f^^m) xi = xi"
unfolding Gromov_extension_isometry_iterates[OF assms(1)] apply (induction m) using assms by auto
have *: "u y n = Busemann_function_at xi ((f^^m) ((f^^n) y)) ((f^^m) y)"
apply (subst P[symmetric]) unfolding Busemann_function_isometry[OF isometry_iterates[OF ‹isometry f›]] u_def by auto
show ?thesis
unfolding * unfolding u_def using Busemann_function_quasi_morphism[of xi "(f^^(m+n)) y" "(f^^m) y" y]
unfolding funpow_add comp_def by auto
qed
define l where "l = (λy. lim (λn. u y n/n))"
have A: "abs(u y k - k * l y) ≤ 2 * deltaG(TYPE('a))" for y k
unfolding l_def using almost_additive_converges(2) * by auto
then have *: "abs(Busemann_function_at xi ((f^^k) y) y - k * l y) ≤ 2 * deltaG(TYPE('a))" for y k
unfolding u_def by auto
have "l basepoint = additive_strength f xi"
unfolding l_def u_def additive_strength_def by auto
have "abs(k * l basepoint - k * l x) ≤ 4 * deltaG(TYPE('a)) + 2 * dist basepoint x" for k::nat
proof -
have "abs(k * l basepoint - k * l x) = abs((Busemann_function_at xi ((f^^k) x) x - k * l x) - (Busemann_function_at xi ((f^^k) basepoint) basepoint - k * l basepoint)
+ (Busemann_function_at xi ((f^^k) basepoint) basepoint - Busemann_function_at xi ((f^^k) x) x))"
by auto
also have "... ≤ abs (Busemann_function_at xi ((f^^k) x) x - k * l x) + abs (Busemann_function_at xi ((f^^k) basepoint) basepoint - k * l basepoint)
+ abs (Busemann_function_at xi ((f^^k) basepoint) basepoint - Busemann_function_at xi ((f^^k) x) x)"
by auto
also have "... ≤ 2 * deltaG(TYPE('a)) + 2 * deltaG(TYPE('a)) + (dist ((f^^k) basepoint) ((f^^k) x) + dist basepoint x)"
by (intro mono_intros *)
also have "... = 4 * deltaG(TYPE('a)) + 2 * dist basepoint x"
unfolding isometryD[OF isometry_iterates[OF assms(1)]] by auto
finally show ?thesis by auto
qed
moreover have "u = v" if H: "⋀k::nat. abs(k * u - k * v) ≤ C" for u v C::real
proof -
have "(λn. abs(u - v)) ⇢ 0"
proof (rule tendsto_sandwich[of "λn. 0" _ _ "λn::nat. C/n"], auto)
have "(λn. C*(1/n)) ⇢ C * 0" by (intro tendsto_intros)
then show "(λn. C/n) ⇢ 0" by auto
have "¦u - v¦ ≤ C / real n" if "n ≥ 1" for n
using H[of n] that apply (simp add: divide_simps algebra_simps)
by (metis H abs_mult abs_of_nat right_diff_distrib')
then show "∀⇩F n in sequentially. ¦u - v¦ ≤ C / real n"
unfolding eventually_sequentially by auto
qed
then show ?thesis
by (metis LIMSEQ_const_iff abs_0_eq eq_iff_diff_eq_0)
qed
ultimately have "l basepoint = l x" by auto
show ?thesis
using A[of x n] unfolding u_def ‹l basepoint = l x›[symmetric] ‹l basepoint = additive_strength f xi› by auto
qed
lemma additive_strength_as_limit [tendsto_intros]:
assumes "isometry f" "Gromov_extension f xi = xi"
shows "(λn. Busemann_function_at xi ((f^^n) x) x/n) ⇢ additive_strength f xi"
proof -
have "(λn. abs(Busemann_function_at xi ((f^^n) x) x/n - additive_strength f xi)) ⇢ 0"
apply (rule tendsto_sandwich[of "λn. 0" _ _ "λn. (2 * deltaG(TYPE('a))) * (1/real n)"], auto)
unfolding eventually_sequentially apply (rule exI[of _ 1])
using Busemann_function_eq_additive_strength[OF assms] apply (simp add: divide_simps algebra_simps)
using tendsto_mult[OF _ lim_1_over_n] by auto
then show ?thesis
using LIM_zero_iff tendsto_rabs_zero_cancel by blast
qed
text ‹The additive strength measures the amount of displacement towards a fixed point at infinity.
Therefore, the distance from $x$ to $f^n x$ is at least $n$ times the additive strength, but one
might think that it might be larger, if there is displacement along the horospheres. It turns out
that this is not the case: the displacement along the horospheres is at most logarithmic (this is
a classical property of parabolic isometries in hyperbolic spaces), and in fact it is bounded for
loxodromic elements.
We prove here that the growth is at most logarithmic in all cases, using a small computation based
on the hyperbolicity inequality, expressed in Lemma \verb+dist_minus_Busemann_max_ineq+ above.
This lemma will be used below to show that the translation length is the absolute value of the
additive strength.›
lemma dist_le_additive_strength:
assumes "isometry (f::'a::Gromov_hyperbolic_space ⇒ 'a)" "Gromov_extension f xi = xi" "additive_strength f xi ≥ 0" "n ≥ 1"
shows "dist x ((f^^n) x) ≤ dist x (f x) + real n * additive_strength f xi + ceiling (log 2 n) * 16 * deltaG(TYPE('a))"
proof -
have A: "⋀n. n ∈ {1..2^k} ⟹ dist x ((f^^n) x) - real n * additive_strength f xi ≤ dist x (f x) + k * 16 * deltaG(TYPE('a))" for k
proof (induction k)
case 0
fix n::nat assume "n ∈ {1..2^0}"
then have "n = 1" by auto
then show "dist x ((f^^n) x) - real n * additive_strength f xi ≤ dist x (f x) + real 0 * 16 * deltaG(TYPE('a))"
using assms(3) by auto
next
case (Suc k)
fix N::nat assume "N ∈ {1..2^(Suc k)}"
then consider "N ∈ {1..2^k}" | "N ∈ {2^k<..2^(Suc k)}" using not_le by auto
then show "dist x ((f ^^ N) x) - real N * additive_strength f xi ≤ dist x (f x) + real (Suc k) * 16 * deltaG TYPE('a)"
proof (cases)
case 1
show ?thesis by (rule order_trans[OF Suc.IH[OF 1]], auto simp add: algebra_simps)
next
case 2
define m::nat where "m = N - 2^k"
define n::nat where "n = 2^k"
have nm: "N = n+m" "m ∈ {1..2^k}" "n ∈ {1..2^k}"unfolding m_def n_def using 2 by auto
have *: "(f^^(n+m)) x = (f^^n) ((f^^m) x)"
unfolding funpow_add comp_def by auto
have **: "(f^^(n+m)) x = (f^^m) ((f^^n) x)"
apply (subst add.commute) unfolding funpow_add comp_def by auto
have "dist x ((f^^N) x) - N * additive_strength f xi - 2 * deltaG(TYPE('a)) ≤ dist x ((f^^(n+m)) x) - Busemann_function_at xi ((f^^(n+m)) x) x"
unfolding nm(1) using Busemann_function_eq_additive_strength[OF assms(1) assms(2), of "n+m" x] by auto
also have "... ≤ max (dist x ((f^^n) x) - Busemann_function_at xi ((f^^n) x) x) (dist ((f^^n) x) ((f^^(n+m)) x) - Busemann_function_at xi ((f^^(n+m)) x) ((f^^n) x) - 2 * Busemann_function_at xi ((f^^n) x) x) + 8 * deltaG(TYPE('a))"
using dist_minus_Busemann_max_ineq by auto
also have "... ≤ max (dist x ((f^^n) x) - (n * additive_strength f xi - 2 * deltaG(TYPE('a)))) (dist ((f^^n) x) ((f^^(n+m)) x) - (m * additive_strength f xi - 2 * deltaG(TYPE('a))) - 2 * (n * additive_strength f xi - 2 * deltaG(TYPE('a)))) + 8 * deltaG(TYPE('a))"
unfolding ** apply (intro mono_intros)
using Busemann_function_eq_additive_strength[OF assms(1) assms(2), of n x] Busemann_function_eq_additive_strength[OF assms(1) assms(2), of m "(f^^n) x"] by auto
also have "... ≤ max (dist x ((f^^n) x) - n * additive_strength f xi + 6 * deltaG(TYPE('a))) (dist x ((f^^m) x) - m * additive_strength f xi + 6 * deltaG(TYPE('a))) + 8 * deltaG(TYPE('a))"
unfolding * isometryD(2)[OF isometry_iterates[OF assms(1)], of n] using assms(3) by (intro mono_intros, auto)
also have "... = max (dist x ((f^^n) x) - n * additive_strength f xi) (dist x ((f^^m) x) - m * additive_strength f xi) + 14 * deltaG(TYPE('a))"
unfolding max_add_distrib_left[symmetric] by auto
also have "... ≤ dist x (f x) + k * 16 * deltaG(TYPE('a)) + 14 * deltaG(TYPE('a))"
using nm by (auto intro!: Suc.IH)
finally show ?thesis by (auto simp add: algebra_simps)
qed
qed
define k::nat where "k = nat(ceiling (log 2 n))"
have "n ≤ 2^k" unfolding k_def
by (meson less_log2_of_power not_le real_nat_ceiling_ge)
then have "dist x ((f^^n) x) - real n * additive_strength f xi ≤ dist x (f x) + k * 16 * deltaG(TYPE('a))"
using A[of n k] ‹n ≥ 1› by auto
moreover have "real (nat ⌈log 2 (real n)⌉) = real_of_int ⌈log 2 (real n)⌉"
by (metis Transcendental.log_one ‹n ≤ 2 ^ k› assms(4) ceiling_zero int_ops(2) k_def le_antisym nat_eq_iff2 of_int_1 of_int_of_nat_eq order_refl power_0)
ultimately show ?thesis unfolding k_def by (auto simp add: algebra_simps)
qed
text ‹The strength of the inverse of a map is the opposite of the strength of the map.›
lemma additive_strength_inv:
assumes "isometry (f::'a::Gromov_hyperbolic_space ⇒ 'a)" "Gromov_extension f xi = xi"
shows "additive_strength (inv f) xi = - additive_strength f xi"
proof -
have *: "(inv f ^^ n) ((f ^^ n) x) = x" for n x
by (metis assms(1) comp_apply funpow_code_def inv_fn_o_fn_is_id isometry_inverse(2))
have A: "abs(real n * additive_strength f xi + real n * additive_strength (inv f) xi) ≤ 6 * deltaG (TYPE('a))" for n::nat and x::'a
using Busemann_function_quasi_morphism[of xi x "(f^^n) x" x] Busemann_function_eq_additive_strength[OF assms, of n x] Busemann_function_eq_additive_strength[OF isometry_inverse(1)[OF assms(1)]
Gromov_extension_inv_fixed_point[OF assms], of n "(f^^n) x"] unfolding * by auto
have B: "abs(additive_strength f xi + additive_strength (inv f) xi) ≤ 6 * deltaG(TYPE('a)) * (1/n)" if "n ≥ 1" for n::nat
using that A[of n] apply (simp add: divide_simps algebra_simps) unfolding distrib_left[symmetric] by auto
have "(λn. abs(additive_strength f xi + additive_strength (inv f) xi)) ⇢ 6 * deltaG(TYPE('a)) * 0"
apply (rule tendsto_sandwich[of "λn. 0" _ _ "λn. 6 * deltaG(TYPE('a)) * (1/real n)"], simp)
unfolding eventually_sequentially apply (rule exI[of _ 1]) using B apply simp
by (simp, intro tendsto_intros)
then show ?thesis
using LIMSEQ_unique mult_zero_right tendsto_const by fastforce
qed
text ‹We will now prove that the stable translation length of an isometry is given by the absolute
value of its strength at any fixed point. We start with the case where the strength is nonnegative,
and then reduce to this case by considering the map or its inverse.›
lemma stable_translation_length_eq_additive_strength_aux:
assumes "isometry (f::'a::Gromov_hyperbolic_space ⇒ 'a)" "Gromov_extension f xi = xi" "additive_strength f xi ≥ 0"
shows "stable_translation_length f = additive_strength f xi"
proof -
have "(λn. dist x ((f^^n) x)/n) ⇢ additive_strength f xi" for x
proof (rule tendsto_sandwich[of "λn. (n * additive_strength f xi - 2 * deltaG(TYPE('a)))/real n" _ _ "λn. (dist x (f x) + n * additive_strength f xi + ceiling (log 2 n) * 16 * deltaG(TYPE('a)))/ n"])
have "n * additive_strength f xi - 2 * deltaG TYPE('a) ≤ dist x ((f ^^ n) x)" for n
using Busemann_function_eq_additive_strength[OF assms(1) assms(2), of n x] Busemann_function_le_dist[of xi "(f^^n) x" x]
by (simp add: dist_commute)
then have "(n * additive_strength f xi - 2 * deltaG TYPE('a)) / n ≤ dist x ((f ^^ n) x) / n" if "n ≥ 1" for n
using that by (simp add: divide_simps)
then show "∀⇩F n in sequentially. (real n * additive_strength f xi - 2 * deltaG TYPE('a)) / real n ≤ dist x ((f ^^ n) x) / real n"
unfolding eventually_sequentially by auto
have B: "(λn. additive_strength f xi - (2 * deltaG(TYPE('a))) * (1/n)) ⇢ additive_strength f xi - (2 * deltaG(TYPE('a))) * 0"
by (intro tendsto_intros)
show "(λn. (real n * additive_strength f xi - 2 * deltaG TYPE('a)) / real n) ⇢ additive_strength f xi"
proof (rule Lim_transform_eventually)
show "eventually (λn. additive_strength f xi - (2 * deltaG(TYPE('a))) * (1/n) = (real n * additive_strength f xi - 2 * deltaG TYPE('a)) / real n) sequentially"
unfolding eventually_sequentially apply (rule exI[of _ 1]) by (simp add: divide_simps)
qed (use B in auto)
have "dist x ((f^^n) x) ≤ dist x (f x) + n * additive_strength f xi + ceiling (log 2 n) * 16 * deltaG(TYPE('a))" if "n ≥ 1" for n
using dist_le_additive_strength[OF assms that] by simp
then have "(dist x ((f^^n) x))/n ≤ (dist x (f x) + n * additive_strength f xi + ceiling (log 2 n) * 16 * deltaG(TYPE('a)))/n" if "n ≥ 1" for n
using that by (simp add: divide_simps)
then show "∀⇩F n in sequentially. dist x ((f ^^ n) x) / real n ≤ (dist x (f x) + real n * additive_strength f xi + real_of_int (⌈log 2 (real n)⌉ * 16) * deltaG TYPE('a)) / real n"
unfolding eventually_sequentially by auto
have B: "(λn. dist x (f x) * (1/n) + additive_strength f xi + 16 * deltaG TYPE('a) * (⌈log 2 n⌉ / n)) ⇢ dist x (f x) * 0 + additive_strength f xi + 16 * deltaG TYPE('a) * 0"
by (intro tendsto_intros)
show "(λn. (dist x (f x) + n * additive_strength f xi + real_of_int (⌈log 2 n⌉ * 16) * deltaG TYPE('a)) / real n) ⇢ additive_strength f xi"
proof (rule Lim_transform_eventually)
show "eventually (λn. dist x (f x) * (1/n) + additive_strength f xi + 16 * deltaG TYPE('a) * (⌈log 2 n⌉ / n) = (dist x (f x) + real n * additive_strength f xi + real_of_int (⌈log 2 (real n)⌉ * 16) * deltaG TYPE('a)) / real n) sequentially"
unfolding eventually_sequentially apply (rule exI[of _ 1]) by (simp add: algebra_simps divide_simps)
qed (use B in auto)
qed
then show ?thesis
using LIMSEQ_unique stable_translation_length_as_pointwise_limit[OF isometryD(4)[OF assms(1)]] by blast
qed
lemma stable_translation_length_eq_additive_strength:
assumes "isometry (f::'a::Gromov_hyperbolic_space ⇒ 'a)" "Gromov_extension f xi = xi"
shows "stable_translation_length f = abs(additive_strength f xi)"
proof (cases "additive_strength f xi ≥ 0")
case True
then show ?thesis using stable_translation_length_eq_additive_strength_aux[OF assms] by auto
next
case False
then have *: "abs(additive_strength f xi) = additive_strength (inv f) xi"
unfolding additive_strength_inv[OF assms] by auto
show ?thesis
unfolding * stable_translation_length_inv[OF assms(1), symmetric]
using stable_translation_length_eq_additive_strength_aux[OF isometry_inverse(1)[OF assms(1)] Gromov_extension_inv_fixed_point[OF assms]] * by auto
qed
subsection ‹Elliptic isometries›
text ‹Elliptic isometries are the simplest ones: they have bounded orbits.›
definition elliptic_isometry::"('a::Gromov_hyperbolic_space ⇒ 'a) ⇒ bool"
where "elliptic_isometry f = (isometry f ∧ (∀x. bounded {(f^^n) x|n. True}))"
lemma elliptic_isometryD:
assumes "elliptic_isometry f"
shows "bounded {(f^^n) x |n. True}"
"isometry f"
using assms unfolding elliptic_isometry_def by auto
lemma elliptic_isometryI [intro]:
assumes "bounded {(f^^n) x |n. True}"
"isometry f"
shows "elliptic_isometry f"
proof -
have "bounded {(f^^n) y |n. True}" for y
proof -
obtain c e where c: "⋀n. dist c ((f^^n) x) ≤ e"
using assms(1) unfolding bounded_def by auto
have "dist c ((f^^n) y) ≤ e + dist x y" for n
proof -
have "dist c ((f^^n) y) ≤ dist c ((f^^n) x) + dist ((f^^n) x) ((f^^n) y)"
by (intro mono_intros)
also have "... ≤ e + dist x y"
using c[of n] isometry_iterates[OF assms(2), of n] by (intro mono_intros, auto simp add: isometryD)
finally show ?thesis by simp
qed
then show ?thesis
unfolding bounded_def by auto
qed
then show ?thesis unfolding elliptic_isometry_def using assms by auto
qed
text ‹The inverse of an elliptic isometry is an elliptic isometry.›
lemma elliptic_isometry_inv:
assumes "elliptic_isometry f"
shows "elliptic_isometry (inv f)"
proof -
obtain c e where A: "⋀n. dist c ((f^^n) basepoint) ≤ e"
using elliptic_isometryD(1)[OF assms, of basepoint] unfolding bounded_def by auto
have "c = (f^^n) (((inv f)^^n) c)" for n
using fn_o_inv_fn_is_id[OF isometry_inverse(2)[OF elliptic_isometryD(2)[OF assms]], of n]
unfolding comp_def by metis
then have "dist ((f^^n) (((inv f)^^n) c)) ((f^^n) basepoint) ≤ e" for n
using A by auto
then have B: "dist basepoint (((inv f)^^n) c) ≤ e" for n
unfolding isometryD(2)[OF isometry_iterates[OF elliptic_isometryD(2)[OF assms]]] by (auto simp add: dist_commute)
show ?thesis
apply (rule elliptic_isometryI[of _ c])
using isometry_inverse(1)[OF elliptic_isometryD(2)[OF assms]] B unfolding bounded_def by auto
qed
text ‹The inverse of a bijective map is an elliptic isometry if and only if the original map is.›
lemma elliptic_isometry_inv_iff:
assumes "bij f"
shows "elliptic_isometry (inv f) ⟷ elliptic_isometry f"
using elliptic_isometry_inv[of f] elliptic_isometry_inv[of "inv f"] inv_inv_eq[OF assms] by auto
text ‹The identity is an elliptic isometry.›
lemma elliptic_isometry_id:
"elliptic_isometry id"
by (intro elliptic_isometryI isometryI, auto)
text ‹The translation length of an elliptic isometry is $0$.›
lemma elliptic_isometry_stable_translation_length:
assumes "elliptic_isometry f"
shows "stable_translation_length f = 0"
proof -
obtain x::'a where True by auto
have "bounded {(f^^n) x|n. True}"
using elliptic_isometryD[OF assms] by auto
then obtain c C where cC: "⋀n. dist c ((f^^n) x) ≤ C"
unfolding bounded_def by auto
have "(λn. dist x ((f^^n) x)/n) ⇢ 0"
proof (rule tendsto_sandwich[of "λ_. 0" _ sequentially "λn. 2 * C / n"])
have "(λn. 2 * C * (1 / real n)) ⇢ 2 * C * 0" by (intro tendsto_intros)
then show "(λn. 2 * C / real n) ⇢ 0" by auto
have "dist x ((f ^^ n) x) / real n ≤ 2 * C / real n" for n
using cC[of 0] cC[of n] dist_triangle[of x "(f^^n) x" c] by (auto simp add: algebra_simps divide_simps dist_commute)
then show "eventually (λn. dist x ((f ^^ n) x) / real n ≤ 2 * C / real n) sequentially"
by auto
qed (auto)
moreover have "(λn. dist x ((f^^n) x)/n) ⇢ stable_translation_length f"
by (rule stable_translation_length_as_pointwise_limit[OF isometry_on_lipschitz[OF isometryD(1)[OF elliptic_isometryD(2)[OF assms]]]])
ultimately show ?thesis
using LIMSEQ_unique by auto
qed
text ‹If an isometry has a fixed point, then it is elliptic.›
lemma isometry_with_fixed_point_is_elliptic:
assumes "isometry f" "f x = x"
shows "elliptic_isometry f"
proof -
have *: "(f^^n) x = x" for n
apply (induction n) using assms(2) by auto
show ?thesis
apply (rule elliptic_isometryI[of _ x, OF _ assms(1)]) unfolding * by auto
qed
subsection ‹Parabolic and loxodromic isometries›
text ‹An isometry is parabolic if it is not elliptic and if its translation length vanishes.›
definition parabolic_isometry::"('a::Gromov_hyperbolic_space ⇒ 'a) ⇒ bool"
where "parabolic_isometry f = (isometry f ∧ ¬elliptic_isometry f ∧ stable_translation_length f = 0)"
text ‹An isometry is loxodromic if it is not elliptic and if its translation length is nonzero.›
definition loxodromic_isometry::"('a::Gromov_hyperbolic_space ⇒ 'a) ⇒ bool"
where "loxodromic_isometry f = (isometry f ∧ ¬elliptic_isometry f ∧ stable_translation_length f ≠ 0)"
text ‹The main features of such isometries are expressed in terms of their fixed points at infinity.
We define them now, but proving that the definitions make sense will take some work.›
definition neutral_fixed_point::"('a::Gromov_hyperbolic_space ⇒ 'a) ⇒ 'a Gromov_completion"
where "neutral_fixed_point f = (SOME xi. xi ∈ Gromov_boundary ∧ Gromov_extension f xi = xi ∧ additive_strength f xi = 0)"
definition attracting_fixed_point::"('a::Gromov_hyperbolic_space ⇒ 'a) ⇒ 'a Gromov_completion"
where "attracting_fixed_point f = (SOME xi. xi ∈ Gromov_boundary ∧ Gromov_extension f xi = xi ∧ additive_strength f xi < 0)"
definition repelling_fixed_point::"('a::Gromov_hyperbolic_space ⇒ 'a) ⇒ 'a Gromov_completion"
where "repelling_fixed_point f = (SOME xi. xi ∈ Gromov_boundary ∧ Gromov_extension f xi = xi ∧ additive_strength f xi > 0)"
lemma parabolic_isometryD:
assumes "parabolic_isometry f"
shows "isometry f"
"¬bounded {(f^^n) x|n. True}"
"stable_translation_length f = 0"
"¬elliptic_isometry f"
using assms unfolding parabolic_isometry_def by auto
lemma parabolic_isometryI:
assumes "isometry f"
"¬bounded {(f^^n) x|n. True}"
"stable_translation_length f = 0"
shows "parabolic_isometry f"
using assms unfolding parabolic_isometry_def elliptic_isometry_def by auto
lemma loxodromic_isometryD:
assumes "loxodromic_isometry f"
shows "isometry f"
"¬bounded {(f^^n) x|n. True}"
"stable_translation_length f > 0"
"¬elliptic_isometry f"
using assms unfolding loxodromic_isometry_def
by (auto, meson dual_order.antisym not_le stable_translation_length_nonneg)
text ‹To have a loxodromic isometry, it suffices to know that the stable translation length is
nonzero, as elliptic isometries have zero translation length.›
lemma loxodromic_isometryI:
assumes "isometry f"
"stable_translation_length f ≠ 0"
shows "loxodromic_isometry f"
using assms elliptic_isometry_stable_translation_length unfolding loxodromic_isometry_def by auto
text ‹Any isometry is elliptic, or parabolic, or loxodromic, and these possibilities are mutually
exclusive.›
lemma elliptic_or_parabolic_or_loxodromic:
assumes "isometry f"
shows "elliptic_isometry f ∨ parabolic_isometry f ∨ loxodromic_isometry f"
using assms unfolding parabolic_isometry_def loxodromic_isometry_def by auto
lemma elliptic_imp_not_parabolic_loxodromic:
assumes "elliptic_isometry f"
shows "¬parabolic_isometry f"
"¬loxodromic_isometry f"
using assms unfolding parabolic_isometry_def loxodromic_isometry_def by auto
lemma parabolic_imp_not_elliptic_loxodromic:
assumes "parabolic_isometry f"
shows "¬elliptic_isometry f"
"¬loxodromic_isometry f"
using assms unfolding parabolic_isometry_def loxodromic_isometry_def by auto
lemma loxodromic_imp_not_elliptic_parabolic:
assumes "loxodromic_isometry f"
shows "¬elliptic_isometry f"
"¬parabolic_isometry f"
using assms unfolding parabolic_isometry_def loxodromic_isometry_def by auto
text ‹The inverse of a parabolic isometry is parabolic.›
lemma parabolic_isometry_inv:
assumes "parabolic_isometry f"
shows "parabolic_isometry (inv f)"
unfolding parabolic_isometry_def using isometry_inverse[of f] elliptic_isometry_inv_iff[of f]
parabolic_isometryD[OF assms] stable_translation_length_inv[of f] by auto
text ‹The inverse of a loxodromic isometry is loxodromic.›
lemma loxodromic_isometry_inv:
assumes "loxodromic_isometry f"
shows "loxodromic_isometry (inv f)"
unfolding loxodromic_isometry_def using isometry_inverse[of f] elliptic_isometry_inv_iff[of f]
loxodromic_isometryD[OF assms] stable_translation_length_inv[of f] by auto
text ‹We will now prove that an isometry which is not elliptic has a fixed point at infinity. This
is very easy if the space is proper (ensuring that the Gromov completion is compact), but in fact
this holds in general. One constructs it by considering a sequence $r_n$ such that $f^{r_n} 0$ tends
to infinity, and additionally $d(f^l 0, 0) < d(f^{r_n} 0, 0)$ for $l < r_n$: this implies the
convergence at infinity of $f^{r_n} 0$, by an argument based on a Gromov product computation -- and
the limit is a fixed point. Moreover, it has nonpositive additive strength, essentially by
construction.›
lemma high_scores:
fixes u::"nat ⇒ real" and i::nat and C::real
assumes "¬(bdd_above (range u))"
shows "∃n. (∀l ≤ n. u l ≤ u n) ∧ u n ≥ C ∧ n ≥ i"
proof -
define M where "M = max C (Max {u l|l. l < i})"
define n where "n = Inf {m. u m > M}"
have "¬(range u ⊆ {..M})"
using assms by (meson bdd_above_Iic bdd_above_mono)
then have "{m. u m > M} ≠ {}"
using assms by (simp add: image_subset_iff not_less)
then have "n ∈ {m. u m > M}" unfolding n_def using Inf_nat_def1 by metis
then have "u n > M" by simp
have "n ≥ i"
proof (rule ccontr)
assume "¬ i ≤ n"
then have *: "n < i" by simp
have "u n ≤ Max {u l|l. l < i}" apply (rule Max_ge) using * by auto
then show False using ‹u n > M› M_def by auto
qed
moreover have "u l ≤ u n" if "l ≤ n" for l
proof (cases "l = n")
case True
then show ?thesis by simp
next
case False
then have "l < n" using ‹l ≤ n› by auto
then have "l ∉ {m. u m > M}"
unfolding n_def by (meson bdd_below_def cInf_lower not_le zero_le)
then show ?thesis using ‹u n > M› by auto
qed
ultimately show ?thesis
using ‹u n > M› M_def less_eq_real_def by auto
qed
lemma isometry_not_elliptic_has_attracting_fixed_point:
assumes "isometry f"
"¬(elliptic_isometry f)"
shows "∃xi ∈ Gromov_boundary. Gromov_extension f xi = xi ∧ additive_strength f xi ≤ 0"
proof -
define u where "u = (λn. dist basepoint ((f^^n) basepoint))"
have NB: "¬(bdd_above (range u))"
proof
assume "bdd_above (range u)"
then obtain C where *: "⋀n. u n ≤ C" unfolding bdd_above_def by auto
have "bounded {(f^^n) basepoint|n. True}"
unfolding bounded_def apply (rule exI[of _ basepoint], rule exI[of _ C])
using * unfolding u_def by auto
then show False
using elliptic_isometryI assms by auto
qed
have "∃r. ∀n. ((∀l ≤ r n. u l ≤ u (r n)) ∧ u (r n) ≥ 2 * n) ∧ r (Suc n) ≥ r n + 1"
apply (rule dependent_nat_choice) using high_scores[OF NB] by (auto) blast
then obtain r::"nat ⇒ nat" where r: "⋀n l. l ≤ r n ⟹ u l ≤ u (r n)"
"⋀n. u (r n) ≥ 2 * n" "⋀n. r (Suc n) ≥ r n + 1"
by auto
then have "strict_mono r"
by (metis Suc_eq_plus1 Suc_le_lessD strict_monoI_Suc)
then have "r n ≥ n" for n
by (simp add: seq_suble)
have A: "dist ((f^^(r p)) basepoint) ((f^^(r n)) basepoint) ≤ dist basepoint ((f^^(r n)) basepoint)" if "n ≥ p" for n p
proof -
have "r n ≥ r p" using ‹n ≥ p› ‹strict_mono r› by (simp add: strict_mono_less_eq)
then have *: "f^^((r n)) = (f^^(r p)) o (f^^(r n - r p))"
unfolding funpow_add[symmetric] by auto
have "dist ((f^^(r p)) basepoint) ((f^^(r n)) basepoint) = dist ((f^^(r p)) basepoint) ((f^^(r p)) ((f^^(r n - r p)) basepoint))"
unfolding * comp_def by auto
also have "... = dist basepoint ((f^^(r n - r p)) basepoint)"
using isometry_iterates[OF assms(1), of "r p"] isometryD by auto
also have "... ≤ dist basepoint ((f^^(r n)) basepoint)"
using r(1)[of "r n - r p" n] unfolding u_def by auto
finally show ?thesis
by simp
qed
have *: "Gromov_product_at basepoint ((f^^(r p)) basepoint) ((f^^(r n)) basepoint) ≥ p" if "n ≥ p" for n p
proof -
have "2 * Gromov_product_at basepoint ((f^^(r p)) basepoint) ((f^^(r n)) basepoint)
= dist basepoint ((f^^(r p)) basepoint) + dist basepoint ((f^^(r n)) basepoint)
- dist ((f^^(r p)) basepoint) ((f^^(r n)) basepoint)"
unfolding Gromov_product_at_def by auto
also have "... ≥ dist basepoint ((f^^(r p)) basepoint)"
using A[OF that] by auto
finally show "Gromov_product_at basepoint ((f^^(r p)) basepoint) ((f^^(r n)) basepoint) ≥ p"
using r(2)[of p] unfolding u_def by auto
qed
have *: "Gromov_product_at basepoint ((f^^(r p)) basepoint) ((f^^(r n)) basepoint) ≥ N" if "n ≥ N" "p ≥ N" for n p N
using *[of n p] *[of p n] that by (auto simp add: Gromov_product_commute intro: le_cases[of n p])
have "Gromov_converging_at_boundary (λn. (f^^(r n)) basepoint)"
apply (rule Gromov_converging_at_boundaryI[of basepoint]) using * by (meson dual_order.trans real_arch_simple)
with Gromov_converging_at_boundary_converges[OF this]
obtain xi where xi: "(λn. to_Gromov_completion ((f^^(r n)) basepoint)) ⇢ xi" "xi ∈ Gromov_boundary"
by auto
then have *: "(λn. Gromov_extension f (to_Gromov_completion ((f^^(r n)) basepoint))) ⇢ xi"
apply (simp, rule Gromov_converging_at_boundary_bounded_perturbation[of _ _ _ "dist basepoint (f basepoint)"])
by (simp add: assms(1) funpow_swap1 isometryD(2) isometry_iterates)
moreover have "(λn. Gromov_extension f (to_Gromov_completion ((f^^(r n)) basepoint))) ⇢ Gromov_extension f xi"
using continuous_on_tendsto_compose[OF Gromov_extension_isometry(2)[OF assms(1)] xi(1)] by auto
ultimately have fxi: "Gromov_extension f xi = xi"
using LIMSEQ_unique by auto
have "Busemann_function_at (to_Gromov_completion ((f^^(r n)) basepoint)) ((f^^(r p)) basepoint) basepoint ≤ 0" if "n ≥ p" for n p
unfolding Busemann_function_inner using A[OF that] by auto
then have A: "eventually (λn. Busemann_function_at (to_Gromov_completion ((f^^(r n)) basepoint)) ((f^^(r p)) basepoint) basepoint ≤ 0) sequentially" for p
unfolding eventually_sequentially by auto
have B: "eventually (λn. Busemann_function_at (to_Gromov_completion ((f^^(r n)) basepoint)) ((f^^(r p)) basepoint) basepoint ≥ Busemann_function_at xi ((f^^(r p)) basepoint) basepoint - 2 * deltaG(TYPE('a)) - 1) sequentially" for p
by (rule eventually_mono[OF Busemann_function_inside_approx[OF _ xi(1), of 1 "((f^^(r p)) basepoint)" basepoint, simplified]], simp)
have "eventually (λn. Busemann_function_at xi ((f^^(r p)) basepoint) basepoint - 2 * deltaG(TYPE('a)) - 1 ≤ 0) sequentially" for p
by (rule eventually_mono[OF eventually_conj[OF A[of p] B[of p]]], simp)
then have *: "Busemann_function_at xi ((f^^(r p)) basepoint) basepoint - 2 * deltaG(TYPE('a)) - 1 ≤ 0" for p
by auto
then have A: "Busemann_function_at xi ((f^^(r p)) basepoint) basepoint / (r p) - (2 * deltaG(TYPE('a)) + 1) * (1/r p) ≤ 0" if "p ≥ 1" for p
using order_trans[OF that ‹p ≤ r p›] by (auto simp add: algebra_simps divide_simps)
have B: "(λp. Busemann_function_at xi ((f^^(p)) basepoint) basepoint / p - (2 * deltaG(TYPE('a)) + 1) * (1/p)) ⇢ additive_strength f xi - (2 * deltaG(TYPE('a)) + 1) * 0"
by (intro tendsto_intros assms fxi)
have "additive_strength f xi - (2 * deltaG TYPE('a) + 1) * 0 ≤ 0"
apply (rule LIMSEQ_le_const2[OF LIMSEQ_subseq_LIMSEQ[OF B ‹strict_mono r›]]) using A unfolding comp_def by auto
then show ?thesis using xi fxi by auto
qed
text ‹Applying the previous result to the inverse map, we deduce that there is also a fixed point
with nonnegative strength.›
lemma isometry_not_elliptic_has_repelling_fixed_point:
assumes "isometry f"
"¬(elliptic_isometry f)"
shows "∃xi ∈ Gromov_boundary. Gromov_extension f xi = xi ∧ additive_strength f xi ≥ 0"
proof -
have *: "¬elliptic_isometry (inv f)"
using elliptic_isometry_inv_iff isometry_inverse(2)[OF assms(1)] assms(2) by auto
obtain xi where xi: "xi ∈ Gromov_boundary" "Gromov_extension (inv f) xi = xi" "additive_strength (inv f) xi ≤ 0"
using isometry_not_elliptic_has_attracting_fixed_point[OF isometry_inverse(1)[OF assms(1)] *] by auto
have *: "Gromov_extension f xi = xi"
using Gromov_extension_inv_fixed_point[OF isometry_inverse(1)[OF assms(1)] xi(2)] inv_inv_eq[OF isometry_inverse(2)[OF assms(1)]] by auto
moreover have "additive_strength f xi ≥ 0"
using additive_strength_inv[OF assms(1) *] xi(3) by auto
ultimately show ?thesis
using xi(1) by auto
qed
subsubsection ‹Parabolic isometries›
text ‹We show that a parabolic isometry has (at least) one neutral fixed point at infinity.›
lemma parabolic_fixed_point:
assumes "parabolic_isometry f"
shows "neutral_fixed_point f ∈ Gromov_boundary"
"Gromov_extension f (neutral_fixed_point f) = neutral_fixed_point f"
"additive_strength f (neutral_fixed_point f) = 0"
proof -
obtain xi where xi: "xi ∈ Gromov_boundary" "Gromov_extension f xi = xi"
using isometry_not_elliptic_has_attracting_fixed_point parabolic_isometryD[OF assms] by blast
moreover have "additive_strength f xi = 0"
using stable_translation_length_eq_additive_strength[OF parabolic_isometryD(1)[OF assms] xi(2)]
parabolic_isometryD(3)[OF assms] by auto
ultimately have A: "∃xi. xi ∈ Gromov_boundary ∧ Gromov_extension f xi = xi ∧ additive_strength f xi = 0"
by auto
show "neutral_fixed_point f ∈ Gromov_boundary"
"Gromov_extension f (neutral_fixed_point f) = neutral_fixed_point f"
"additive_strength f (neutral_fixed_point f) = 0"
unfolding neutral_fixed_point_def using someI_ex[OF A] by auto
qed
text ‹Parabolic isometries have exactly one fixed point, the neutral fixed point at infinity. The
proof goes as follows: if it has another fixed point, then the orbit of a basepoint would stay
on the horospheres centered at both fixed points. But the intersection of two horospheres based
at different points is a a bounded set. Hence, the map has a bounded orbit, and is therefore
elliptic.›
theorem parabolic_unique_fixed_point:
assumes "parabolic_isometry f"
shows "Gromov_extension f xi = xi ⟷ xi = neutral_fixed_point f"
proof (auto simp add: parabolic_fixed_point[OF assms])
assume H: "Gromov_extension f xi = xi"
have *: "additive_strength f xi = 0"
using stable_translation_length_eq_additive_strength[OF parabolic_isometryD(1)[OF assms] H]
parabolic_isometryD(3)[OF assms] by auto
show "xi = neutral_fixed_point f"
proof (rule ccontr)
assume N: "xi ≠ neutral_fixed_point f"
define C where "C = 2 * real_of_ereal (extended_Gromov_product_at basepoint xi (neutral_fixed_point f)) + 4 * deltaG(TYPE('a))"
have A: "dist basepoint ((f^^n) basepoint) ≤ C" for n
proof -
have "dist ((f^^n) basepoint) basepoint - 2 * real_of_ereal (extended_Gromov_product_at basepoint xi (neutral_fixed_point f)) - 2 * deltaG(TYPE('a))
≤ max (Busemann_function_at xi ((f^^n) basepoint) basepoint) (Busemann_function_at (neutral_fixed_point f) ((f^^n) basepoint) basepoint)"
using dist_le_max_Busemann_functions[OF N] by (simp add: algebra_simps)
also have "... ≤ max (n * additive_strength f xi + 2 * deltaG(TYPE('a))) (n * additive_strength f (neutral_fixed_point f) + 2 * deltaG(TYPE('a)))"
apply (intro mono_intros)
using Busemann_function_eq_additive_strength[OF parabolic_isometryD(1)[OF assms] H, of n basepoint]
Busemann_function_eq_additive_strength[OF parabolic_isometryD(1)[OF assms] parabolic_fixed_point(2)[OF assms], of n basepoint]
by auto
also have "... = 2 * deltaG(TYPE('a))"
unfolding * parabolic_fixed_point[OF assms] by auto
finally show ?thesis
unfolding C_def by (simp add: algebra_simps dist_commute)
qed
have "elliptic_isometry f"
apply (rule elliptic_isometryI[of _ basepoint])
using parabolic_isometryD(1)[OF assms] A unfolding bounded_def by auto
then show False
using elliptic_imp_not_parabolic_loxodromic assms by auto
qed
qed
text ‹When one iterates a parabolic isometry, the distance to the starting point can grow at most
logarithmically.›
lemma parabolic_logarithmic_growth:
assumes "parabolic_isometry (f::'a::Gromov_hyperbolic_space ⇒ 'a)" "n ≥ 1"
shows "dist x ((f^^n) x) ≤ dist x (f x) + ceiling (log 2 n) * 16 * deltaG(TYPE('a))"
using dist_le_additive_strength[OF parabolic_isometryD(1)[OF assms(1)] parabolic_fixed_point(2)[OF assms(1)] _ assms(2)]
parabolic_isometryD(3)[OF assms(1)] stable_translation_length_eq_additive_strength[OF parabolic_isometryD(1)[OF assms(1)] parabolic_fixed_point(2)[OF assms(1)]]
by auto
text ‹It follows that there is no parabolic isometry in trees, since the formula in the previous
lemma shows that there is no orbit growth as $\delta = 0$, and therefore orbits are bounded,
contradicting the parabolicity of the isometry.›
lemma tree_no_parabolic_isometry:
assumes "isometry (f::'a::Gromov_hyperbolic_space_0 ⇒ 'a)"
shows "elliptic_isometry f ∨ loxodromic_isometry f"
proof -
have "¬parabolic_isometry f"
proof
assume P: "parabolic_isometry f"
have "dist basepoint ((f^^n) basepoint) ≤ dist basepoint (f basepoint)" if "n ≥ 1" for n
using parabolic_logarithmic_growth[OF P that, of basepoint] by auto
then have *: "dist basepoint ((f^^n) basepoint) ≤ dist basepoint (f basepoint)" for n
by (cases "n ≥ 1", auto simp add: not_less_eq_eq)
have "elliptic_isometry f"
apply (rule elliptic_isometryI[OF _ assms, of basepoint]) using * unfolding bounded_def by auto
then show False
using elliptic_imp_not_parabolic_loxodromic P by auto
qed
then show ?thesis
using elliptic_or_parabolic_or_loxodromic[OF assms] by auto
qed
subsubsection ‹Loxodromic isometries›
text ‹A loxodromic isometry has (at least) two fixed points at infinity, one attracting
and one repelling. We have already constructed fixed points with nonnegative and nonpositive
strengths. Since the strength is nonzero (its absolute value is the stable translation length),
then these fixed points correspond to what we want.›
lemma loxodromic_attracting_fixed_point:
assumes "loxodromic_isometry f"
shows "attracting_fixed_point f ∈ Gromov_boundary"
"Gromov_extension f (attracting_fixed_point f) = attracting_fixed_point f"
"additive_strength f (attracting_fixed_point f) < 0"
proof -
obtain xi where xi: "xi ∈ Gromov_boundary" "Gromov_extension f xi = xi" "additive_strength f xi ≤ 0"
using isometry_not_elliptic_has_attracting_fixed_point loxodromic_isometryD[OF assms] by blast
moreover have "additive_strength f xi < 0"
using stable_translation_length_eq_additive_strength[OF loxodromic_isometryD(1)[OF assms] xi(2)]
loxodromic_isometryD(3)[OF assms] xi(3) by auto
ultimately have A: "∃xi. xi ∈ Gromov_boundary ∧ Gromov_extension f xi = xi ∧ additive_strength f xi < 0"
by auto
show "attracting_fixed_point f ∈ Gromov_boundary"
"Gromov_extension f (attracting_fixed_point f) = attracting_fixed_point f"
"additive_strength f (attracting_fixed_point f) < 0"
unfolding attracting_fixed_point_def using someI_ex[OF A] by auto
qed
lemma loxodromic_repelling_fixed_point:
assumes "loxodromic_isometry f"
shows "repelling_fixed_point f ∈ Gromov_boundary"
"Gromov_extension f (repelling_fixed_point f) = repelling_fixed_point f"
"additive_strength f (repelling_fixed_point f) > 0"
proof -
obtain xi where xi: "xi ∈ Gromov_boundary" "Gromov_extension f xi = xi" "additive_strength f xi ≥ 0"
using isometry_not_elliptic_has_repelling_fixed_point loxodromic_isometryD[OF assms] by blast
moreover have "additive_strength f xi > 0"
using stable_translation_length_eq_additive_strength[OF loxodromic_isometryD(1)[OF assms] xi(2)]
loxodromic_isometryD(3)[OF assms] xi(3) by auto
ultimately have A: "∃xi. xi ∈ Gromov_boundary ∧ Gromov_extension f xi = xi ∧ additive_strength f xi > 0"
by auto
show "repelling_fixed_point f ∈ Gromov_boundary"
"Gromov_extension f (repelling_fixed_point f) = repelling_fixed_point f"
"additive_strength f (repelling_fixed_point f) > 0"
unfolding repelling_fixed_point_def using someI_ex[OF A] by auto
qed
text ‹The attracting and repelling fixed points of a loxodromic isometry are distinct -- precisely
since one is attracting and the other is repelling.›
lemma attracting_fixed_point_neq_repelling_fixed_point:
assumes "loxodromic_isometry f"
shows "attracting_fixed_point f ≠ repelling_fixed_point f"
using loxodromic_repelling_fixed_point[OF assms] loxodromic_attracting_fixed_point[OF assms] by auto
text ‹The attracting fixed point of a loxodromic isometry is indeed attracting. Moreover, the
convergence is uniform away from the repelling fixed point. This is expressed in the following
proposition, where neighborhoods of the repelling and attracting fixed points are given by the property
that the Gromov product with the fixed point is large.
The proof goes as follows. First, the Busemann function with respect to the fixed points at infinity
evolves like the strength. Therefore, $f^n e$ tends to the repulsive fixed point in negative time,
and to the attracting one in positive time. Consider now a general point $x$ with
$(\xi^-, x)_e \leq K$. This means that the geodesics from $e$ to $x$ and $\xi^-$ diverge before
time $K$. For large $n$, since $f^{-n} e$ is close to $\xi^-$, we also get the inequality
$(f^{-n} e, x)_e \leq K$. Applying $f^n$ and using the invariance of the Gromov product under
isometries yields $(e, f^n x)_{f^n e} \leq K$. But this Gromov product is equal to
$d(e, f^n e) - (f^n e, f^n x)_e$ (this is a general property of Gromov products). In particular,
$(f^n e, f^n x) \geq d(e, f^n e) - K$, and moreover $d(e, f^n e)$ is large.
Since $f^n e$ is close to $\xi^+$, it follows that $f^n x$
is also close to $\xi^+$, as desired.
The real proof requires some more care as everything should be done in ereal, and moreover every
inequality is only true up to some multiple of $\delta$. But everything works in the way just
described above.
›
proposition loxodromic_attracting_fixed_point_attracts_uniformly:
assumes "loxodromic_isometry f"
shows "∃N. ∀n ≥ N. ∀x. extended_Gromov_product_at basepoint x (repelling_fixed_point f) ≤ ereal K
⟶ extended_Gromov_product_at basepoint (((Gromov_extension f)^^n) x) (attracting_fixed_point f) ≥ ereal M"
proof -
have I: "isometry f"
using loxodromic_isometryD(1)[OF assms] by simp
have J: "¦ereal r¦ ≠ ∞" for r by auto
text ‹We show that $f^n e$ tends to the repelling fixed point in negative time.›
have "(λn. ereal (Busemann_function_at (repelling_fixed_point f) ((inv f ^^ n) basepoint) basepoint)) ⇢ - ∞"
proof (rule tendsto_sandwich[of "λn. -∞" _ _ "λn. ereal(- real n * additive_strength f (repelling_fixed_point f) + 2 * deltaG(TYPE('a)))", OF _ always_eventually], auto)
fix n
have "Busemann_function_at (repelling_fixed_point f) ((inv f ^^ n) basepoint) basepoint ≤ real n * additive_strength (inv f) (repelling_fixed_point f) + 2 * deltaG(TYPE('a))"
using Busemann_function_eq_additive_strength[OF isometry_inverse(1)[OF I]
Gromov_extension_inv_fixed_point[OF I loxodromic_repelling_fixed_point(2)[OF assms]], of n basepoint] by auto
then show "Busemann_function_at (repelling_fixed_point f) ((inv f ^^ n) basepoint) basepoint ≤ 2 * deltaG(TYPE('a)) - real n * additive_strength f (repelling_fixed_point f)"
by (simp add: I additive_strength_inv assms loxodromic_repelling_fixed_point(2))
next
have "(λn. ereal (2 * deltaG TYPE('a)) + ereal (- real n) * additive_strength f (repelling_fixed_point f)) ⇢ ereal (2 * deltaG (TYPE('a))) + (- ∞) * additive_strength f (repelling_fixed_point f)"
apply (intro tendsto_intros) using loxodromic_repelling_fixed_point(3)[OF assms] by auto
then show "(λn. ereal (2 * deltaG TYPE('a) - real n * additive_strength f (repelling_fixed_point f))) ⇢ - ∞"
using loxodromic_repelling_fixed_point(3)[OF assms] by auto
qed
then have "(λn. to_Gromov_completion (((inv f)^^n) basepoint)) ⇢ repelling_fixed_point f"
by (rule Busemann_function_minus_infinity_imp_convergent[of _ _ basepoint])
then have "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (((inv f)^^n) basepoint)) (repelling_fixed_point f)) ⇢ ∞"
unfolding Gromov_completion_boundary_limit[OF loxodromic_repelling_fixed_point(1)[OF assms]] by simp
then obtain Nr where Nr: "⋀n. n ≥ Nr ⟹ extended_Gromov_product_at basepoint (to_Gromov_completion (((inv f)^^n) basepoint)) (repelling_fixed_point f) ≥ ereal (K + deltaG(TYPE('a)) + 1)"
unfolding Lim_PInfty by auto
text ‹We show that $f^n e$ tends to the attracting fixed point in positive time.›
have "(λn. ereal (Busemann_function_at (attracting_fixed_point f) ((f ^^ n) basepoint) basepoint)) ⇢ - ∞"
proof (rule tendsto_sandwich[of "λn. -∞" _ _ "λn. ereal(real n * additive_strength f (attracting_fixed_point f) + 2 * deltaG(TYPE('a)))", OF _ always_eventually], auto)
fix n
show "Busemann_function_at (attracting_fixed_point f) ((f ^^ n) basepoint) basepoint ≤ real n * additive_strength f (attracting_fixed_point f) + 2 * deltaG(TYPE('a))"
using Busemann_function_eq_additive_strength[OF I loxodromic_attracting_fixed_point(2)[OF assms], of n basepoint] by auto
next
have "(λn. ereal (2 * deltaG TYPE('a)) + ereal (real n) * additive_strength f (attracting_fixed_point f)) ⇢ ereal (2 * deltaG (TYPE('a))) + (∞) * additive_strength f (attracting_fixed_point f)"
apply (intro tendsto_intros) using loxodromic_attracting_fixed_point(3)[OF assms] by auto
then show "(λn. ereal (real n * additive_strength f (attracting_fixed_point f) + 2 * deltaG TYPE('a))) ⇢ - ∞"
using loxodromic_attracting_fixed_point(3)[OF assms] by (auto simp add: algebra_simps)
qed
then have *: "(λn. to_Gromov_completion (((f)^^n) basepoint)) ⇢ attracting_fixed_point f"
by (rule Busemann_function_minus_infinity_imp_convergent[of _ _ basepoint])
then have "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (((f)^^n) basepoint)) (attracting_fixed_point f)) ⇢ ∞"
unfolding Gromov_completion_boundary_limit[OF loxodromic_attracting_fixed_point(1)[OF assms]] by simp
then obtain Na where Na: "⋀n. n ≥ Na ⟹ extended_Gromov_product_at basepoint (to_Gromov_completion (((f)^^n) basepoint)) (attracting_fixed_point f) ≥ ereal (M + deltaG(TYPE('a)))"
unfolding Lim_PInfty by auto
text ‹We show that the distance between $e$ and $f^n e$ tends to infinity.›
have "(λn. extended_Gromov_distance (to_Gromov_completion basepoint) (to_Gromov_completion ((f^^n) basepoint))) ⇢
extended_Gromov_distance (to_Gromov_completion basepoint) (attracting_fixed_point f)"
using * extended_Gromov_distance_continuous[of "to_Gromov_completion basepoint"]
by (metis UNIV_I continuous_on filterlim_compose tendsto_at_iff_tendsto_nhds)
then have "(λn. extended_Gromov_distance (to_Gromov_completion basepoint) (to_Gromov_completion ((f^^n) basepoint))) ⇢ ∞"
using loxodromic_attracting_fixed_point(1)[OF assms] by simp
then obtain Nd where Nd: "⋀n. n ≥ Nd ⟹ dist basepoint ((f^^n) basepoint) ≥ M + K + 3 * deltaG(TYPE('a))"
unfolding Lim_PInfty by auto
text ‹Now, if $n$ is large enough so that all the convergences to infinity above are almost
realized, we show that a point $x$ which is not too close to $\xi^-$ is sent by $f^n$ to a point
close to $\xi^+$, uniformly.›
define N where "N = Nr + Na + Nd"
have "extended_Gromov_product_at basepoint (((Gromov_extension f)^^n) x) (attracting_fixed_point f) ≥ ereal M" if H: "extended_Gromov_product_at basepoint x (repelling_fixed_point f) ≤ K" "n ≥ N" for n x
proof -
have n: "n ≥ Nr" "n ≥ Na" "n ≥ Nd" using that unfolding N_def by auto
have "min (extended_Gromov_product_at basepoint x (to_Gromov_completion (((inv f)^^n) basepoint)))
(extended_Gromov_product_at basepoint (to_Gromov_completion (((inv f)^^n) basepoint)) (repelling_fixed_point f))
≤ extended_Gromov_product_at basepoint x (repelling_fixed_point f) + deltaG(TYPE('a))"
by (intro mono_intros)
also have "... ≤ ereal K + deltaG(TYPE('a))"
apply (intro mono_intros) using H by auto
finally have "min (extended_Gromov_product_at basepoint x (to_Gromov_completion (((inv f)^^n) basepoint)))
(extended_Gromov_product_at basepoint (to_Gromov_completion (((inv f)^^n) basepoint)) (repelling_fixed_point f))
≤ ereal K + deltaG(TYPE('a))"
by simp
moreover have "extended_Gromov_product_at basepoint (to_Gromov_completion (((inv f)^^n) basepoint)) (repelling_fixed_point f) > ereal K + deltaG(TYPE('a))"
using Nr[OF n(1)] ereal_le_less by auto
ultimately have A: "extended_Gromov_product_at basepoint x (to_Gromov_completion (((inv f)^^n) basepoint)) ≤ ereal K + deltaG(TYPE('a))"
using not_le by fastforce
have *: "((inv f)^^n) ((f^^n) z) = z" for z
by (metis I bij_is_inj inj_fn inv_f_f inv_fn isometry_inverse(2))
have **: "x = Gromov_extension ((inv f)^^n) (Gromov_extension (f^^n) x)"
using Gromov_extension_isometry_composition[OF isometry_iterates[OF I] isometry_iterates[OF isometry_inverse(1)[OF I]], of n n]
unfolding comp_def * apply auto by meson
have "extended_Gromov_product_at (((inv f)^^n) ((f^^n) basepoint)) (Gromov_extension ((inv f)^^n) (Gromov_extension (f^^n) x)) (Gromov_extension (((inv f)^^n)) (to_Gromov_completion basepoint)) ≤ ereal K + deltaG(TYPE('a))"
using A by (simp add: * **[symmetric])
then have B: "extended_Gromov_product_at ((f^^n) basepoint) (Gromov_extension (f^^n) x) (to_Gromov_completion basepoint) ≤ ereal K + deltaG(TYPE('a))"
unfolding Gromov_extension_preserves_extended_Gromov_product[OF isometry_iterates[OF isometry_inverse(1)[OF I]]] by simp
have "dist basepoint ((f^^n) basepoint) - deltaG(TYPE('a)) ≤
extended_Gromov_product_at ((f^^n) basepoint) (Gromov_extension (f^^n) x) (to_Gromov_completion basepoint) + extended_Gromov_product_at basepoint (Gromov_extension (f^^n) x) (to_Gromov_completion ((f^^n) basepoint))"
using extended_Gromov_product_add_ge[of basepoint "(f^^n) basepoint" "Gromov_extension (f^^n) x"] by (auto simp add: algebra_simps)
also have "... ≤ (ereal K + deltaG(TYPE('a))) + extended_Gromov_product_at basepoint (Gromov_extension (f^^n) x) (to_Gromov_completion ((f^^n) basepoint))"
by (intro mono_intros B)
finally have "extended_Gromov_product_at basepoint (Gromov_extension (f^^n) x) (to_Gromov_completion ((f^^n) basepoint)) ≥ dist basepoint ((f^^n) basepoint) - (2 * deltaG(TYPE('a)) + K)"
apply (simp only: ereal_minus_le [OF J] ereal_minus(1) [symmetric])
apply (auto simp add: algebra_simps)
apply (metis (no_types, hide_lams) add.assoc add.left_commute mult_2_right plus_ereal.simps(1))
done
moreover have "dist basepoint ((f ^^ n) basepoint) - (2 * deltaG TYPE('a) + K) ≥ M + deltaG(TYPE('a))"
using Nd[OF n(3)] by auto
ultimately have "extended_Gromov_product_at basepoint (Gromov_extension (f^^n) x) (to_Gromov_completion ((f^^n) basepoint)) ≥ ereal (M + deltaG(TYPE('a)))"
using order_trans ereal_le_le by auto
then have "ereal (M + deltaG(TYPE('a))) ≤ min (extended_Gromov_product_at basepoint (Gromov_extension (f^^n) x) (to_Gromov_completion ((f^^n) basepoint)))
(extended_Gromov_product_at basepoint (to_Gromov_completion ((f^^n) basepoint)) (attracting_fixed_point f))"
using Na[OF n(2)] by (simp add: extended_Gromov_product_at_commute)
also have "... ≤ extended_Gromov_product_at basepoint (Gromov_extension (f^^n) x) (attracting_fixed_point f) + deltaG(TYPE('a))"
by (intro mono_intros)
finally have "ereal M ≤ extended_Gromov_product_at basepoint (Gromov_extension (f^^n) x) (attracting_fixed_point f)"
unfolding plus_ereal.simps(1)[symmetric] ereal_add_le_add_iff2 by auto
then show ?thesis
by (simp add: Gromov_extension_isometry_iterates I)
qed
then show ?thesis
by auto
qed
text ‹We deduce pointwise convergence from the previous result.›
lemma loxodromic_attracting_fixed_point_attracts:
assumes "loxodromic_isometry f"
"xi ≠ repelling_fixed_point f"
shows "(λn. ((Gromov_extension f)^^n) xi) ⇢ attracting_fixed_point f"
proof -
have "(λn. extended_Gromov_product_at basepoint (((Gromov_extension f)^^n) xi) (attracting_fixed_point f)) ⇢ ∞"
unfolding Lim_PInfty using loxodromic_attracting_fixed_point_attracts_uniformly[OF assms(1)]
by (metis Gromov_boundary_extended_product_PInf assms(2) ereal_top funpow_code_def infinity_ereal_def linear)
then show ?thesis
unfolding Gromov_completion_boundary_limit[OF loxodromic_attracting_fixed_point(1)[OF assms(1)]] by simp
qed
text ‹Finally, we show that a loxodromic isometry has exactly two fixed points, its attracting and
repelling fixed points defined above. Indeed, we already know that these points are fixed. It
remains to see that there is no other fixed point. But a fixed point which is not the repelling one
is both stationary and attracted to the attracting fixed point by the previous lemma, hence it has
to coincide with the attracting fixed point.›
theorem loxodromic_unique_fixed_points:
assumes "loxodromic_isometry f"
shows "Gromov_extension f xi = xi ⟷ xi = attracting_fixed_point f ∨ xi = repelling_fixed_point f"
proof -
have "xi = attracting_fixed_point f" if H: "Gromov_extension f xi = xi" "xi ≠ repelling_fixed_point f" for xi
proof -
have "((Gromov_extension f)^^n) xi = xi" for n
apply (induction n) using H(1) by auto
then have "(λn. ((Gromov_extension f)^^n) xi) ⇢ xi"
by auto
then show ?thesis
using loxodromic_attracting_fixed_point_attracts[OF assms H(2)] LIMSEQ_unique by auto
qed
then show ?thesis
using loxodromic_attracting_fixed_point(2)[OF assms] loxodromic_repelling_fixed_point(2)[OF assms] by auto
qed
end